Форматирование строк

[Propan]

Скайпа к сожалению нет. В коде массив d_mapping заполняется 3мя значениями. В d_mapping().sname вручную вносятся имена полей по которым ведётся поиск. Через два цикла заполняются d_mapping().scol1 - номер искомого столбца на 1ом листе, d_mapping().scol2 - номер искомого столбца на 2ом листе.

[EducatedFool]

Вот теперь всё работает:
(только не забудьте на второй лист добавить столбец СУММА)

Option Compare Text
Type t_mapping: sname As String: scol1 As Integer: scol2 As Integer: End Type

Sub НоваяВерсия()
    Application.ScreenUpdating = False
    Dim d_mapping(1 To 4) As t_mapping
    Dim sh1 As Worksheet: Set sh1 = Sheets("Лист1")
    Dim sh2 As Worksheet: Set sh2 = Sheets("Лист2")
    sh1.UsedRange.EntireRow.Font.Bold = False: sh2.UsedRange.EntireRow.Font.Bold = False

    d_mapping(1).sname = "Фамилия": d_mapping(2).sname = "Имя"
    d_mapping(3).sname = "Отчество": d_mapping(4).sname = "Сумма"

    On Error Resume Next
    For i = LBound(d_mapping) To UBound(d_mapping)
        d_mapping(i).scol1 = sh1.Rows(1).Find(d_mapping(i).sname).Column
        d_mapping(i).scol2 = sh2.Rows(1).Find(d_mapping(i).sname).Column
        If d_mapping(i).scol1 = 0 Then MsgBox "На листе  Лист1  не найден столбец  " & _
           d_mapping(i).sname, vbCritical, "Ошибка": Exit Sub
        If d_mapping(i).scol2 = 0 Then MsgBox "На листе  Лист2  не найден столбец  " & _
           d_mapping(i).sname, vbCritical, "Ошибка": Exit Sub
    Next i

    arr1 = sh1.UsedRange.Offset(1).Value: arr2 = sh2.UsedRange.Offset(1).Value
    Dim coll As New Collection, collTemp As New Collection
    ' coll - коллекция значений повторяющихся строк, collTemp - уникальных

    For i = LBound(arr1) To UBound(arr1)
        v = Trim$(arr1(i, d_mapping(1).scol1)) & "#" & Trim$(arr1(i, d_mapping(2).scol1)) & _
            "#" & Trim$(arr1(i, d_mapping(3).scol1)) & "#" & Trim$(arr1(i, d_mapping(4).scol1))
        If Len(v) > UBound(d_mapping) - LBound(d_mapping) Then    ' если строка не пустая
            ' Debug.Print v
            Err.Clear: collTemp.Add v, v: If Err.Number = 457 Then coll.Add v, v
        End If
    Next i

    For i = LBound(arr2) To UBound(arr2)
        v = Trim$(arr2(i, d_mapping(1).scol2)) & "#" & Trim$(arr2(i, d_mapping(2).scol2)) & _
            "#" & Trim$(arr2(i, d_mapping(3).scol2)) & "#" & Trim$(arr2(i, d_mapping(4).scol2))
        If Len(v) > UBound(d_mapping) - LBound(d_mapping) Then    ' если строка не пустая
            ' Debug.Print v
            Err.Clear: collTemp.Add v, v: If Err.Number = 457 Then coll.Add v, v
        End If
    Next i
    Debug.Print "Уникальных записей: " & collTemp.Count & ",  повторяющихся: " & coll.Count

    ' а теперь перебираем всё по-новой :)
    For i = LBound(arr1) To UBound(arr1)
        v = Trim$(arr1(i, d_mapping(1).scol1)) & "#" & Trim$(arr1(i, d_mapping(2).scol1)) & _
            "#" & Trim$(arr1(i, d_mapping(3).scol1)) & "#" & Trim$(arr1(i, d_mapping(4).scol1))
        If Len(v) > UBound(d_mapping) - LBound(d_mapping) Then    ' если строка не пустая
            Err.Clear: coll.Add v, v
            sh1.Rows(i + 1).Font.Bold = Err.Number = 457
        End If
    Next i

    For i = LBound(arr2) To UBound(arr2)
        v = Trim$(arr2(i, d_mapping(1).scol2)) & "#" & Trim$(arr2(i, d_mapping(2).scol2)) & _
            "#" & Trim$(arr2(i, d_mapping(3).scol2)) & "#" & Trim$(arr2(i, d_mapping(4).scol2))
        If Len(v) > UBound(d_mapping) - LBound(d_mapping) Then    ' если строка не пустая
            Err.Clear: coll.Add v, v
            sh2.Rows(i + 1).Font.Bold = Err.Number = 457
        End If
    Next i
End Sub

Пример во вложении:

[Propan]

Спасибо большое, в таком коде нужно разбираться, но это наименьшая из проблем)
Только почему-то в загруженном вами примере выделяются всё равно не те строки, которые полностью совпадают по 4 столбцам: Фамилия, Имя, Отчество, Сумма

[Propan]

Всё понял. Это не понимание возникло из-за повторения одной из строк два раза на втором листе

[Propan]

И ещё два вопроса.
С чем связано то, что когда я задаю в массив d_mapping ещё одно значение d_mapping(5).sname="Количество", то есть сравниваю по пяти столбцам, сравнение идёт всё равно только по 4ём

И когда вместо выделения жирным шрифтом хочу задать выделение серым цветом sh1.Rows(i + 1).Font.ColorIndex = 15, закрашиваются все ячейки диапазона

[EducatedFool]

Вот исправленный Вариант:

Option Compare Text
Type t_mapping: sname As String: scol1 As Integer: scol2 As Integer: End Type
Dim d_mapping() As t_mapping, arr1(), arr2(): Const Sep = "#"

Sub ПримерИспользования()
    НоваяВерсия2 "Лист1", "Лист2", "Фамилия", "Имя", "Отчество", "Сумма", "Количество"
End Sub


Sub НоваяВерсия2(ByVal Sh1Name As String, ByVal Sh2Name As String, ParamArray ColumnsNames() As Variant)

    Application.ScreenUpdating = False: Dim i As Long
    Dim sh1 As Worksheet, sh2 As Worksheet: Set sh1 = Sheets(Sh1Name): Set sh2 = Sheets(Sh2Name)

    УбратьФорматирование sh1.UsedRange.EntireRow
    УбратьФорматирование sh2.UsedRange.EntireRow

    ReDim d_mapping(LBound(ColumnsNames) To UBound(ColumnsNames)) As t_mapping
    For i = LBound(ColumnsNames) To UBound(ColumnsNames)
        d_mapping(i).sname = ColumnsNames(i)
        ' Debug.Print d_mapping(i).sname
    Next i

    On Error Resume Next
    For i = LBound(d_mapping) To UBound(d_mapping)
        d_mapping(i).scol1 = sh1.Rows(1).Find(d_mapping(i).sname).Column
        d_mapping(i).scol2 = sh2.Rows(1).Find(d_mapping(i).sname).Column
        If d_mapping(i).scol1 = 0 Then MsgBox "На листе  " & Sh1Name & "  не найден столбец  " & _
           d_mapping(i).sname, vbCritical, "Ошибка": Exit Sub
        If d_mapping(i).scol2 = 0 Then MsgBox "На листе  " & Sh2Name & "  не найден столбец  " & _
           d_mapping(i).sname, vbCritical, "Ошибка": Exit Sub
    Next i

    arr1 = sh1.UsedRange.Offset(1).Value: arr2 = sh2.UsedRange.Offset(1).Value
    Dim coll As New Collection, collTemp As New Collection
    ' coll - коллекция значений повторяющихся строк, collTemp - уникальных

    On Error Resume Next
    For i = LBound(arr1) To UBound(arr1)
        v = Строка1(i)
        If Len(v) > UBound(d_mapping) - LBound(d_mapping) Then    ' если строка не пустая
            Err.Clear: collTemp.Add v, v: If Err.Number = 457 Then coll.Add v, v
        End If
    Next i

    For i = LBound(arr2) To UBound(arr2)
        v = Строка2(i)
        If Len(v) > UBound(d_mapping) - LBound(d_mapping) Then    ' если строка не пустая
            Err.Clear: collTemp.Add v, v: If Err.Number = 457 Then coll.Add v, v
        End If
    Next i
    Debug.Print "Уникальных записей: " & collTemp.Count & ",  повторяющихся: " & coll.Count

    ' а теперь перебираем всё по-новой :)
    For i = LBound(arr1) To UBound(arr1)
        v = Строка1(i)
        If Len(v) > UBound(d_mapping) - LBound(d_mapping) Then    ' если строка не пустая
            Err.Clear: coll.Add v, v: If Err.Number = 457 Then ФорматироватьСтроку sh1.Rows(i + 1)
        End If
    Next i

    For i = LBound(arr2) To UBound(arr2)
        v = Строка2(i)
        If Len(v) > UBound(d_mapping) - LBound(d_mapping) Then    ' если строка не пустая
            Err.Clear: coll.Add v, v: If Err.Number = 457 Then ФорматироватьСтроку sh2.Rows(i + 1)
        End If
    Next i
End Sub

Sub ФорматироватьСтроку(ByRef ra As Range)
    With ra.Font: .Bold = True: .Size = 12: .Color = vbRed: End With
End Sub

Sub УбратьФорматирование(ByRef ra As Range)
    With ra.Font: .Bold = False: .Size = 10: .Color = vbBlack: End With
End Sub

Function Строка1(Позиция As Long) As String
    For i = LBound(d_mapping) To UBound(d_mapping)
        Строка1 = Строка1 & Sep & arr1(Позиция, d_mapping(i).scol1)
    Next i: Строка1 = Mid$(Строка1, 2)
End Function
Function Строка2(Позиция As Long) As String
    For i = LBound(d_mapping) To UBound(d_mapping)
        Строка2 = Строка2 & Sep & arr2(Позиция, d_mapping(i).scol2)
    Next i: Строка2 = Mid$(Строка2, 2)
End Function

Пример во вложении: