如果不同，则匹配两张纸上的数据颜色为黄色

Question

我正在尝试检查两个工作表上的数据。

逻辑：

IF Col A-B-C Sheet2 上的数据与 Sheet1 上任何行同一列上的数据匹配。然后检查两张纸上的 col E 和 col F，如果任何数据不同，则将它们涂成黄色在 Sheet2

代码：

Option Explicit
Sub CheckData()

Dim wb, wn As Worksheet
Dim i, j, m
Dim strA, strB, strC, strE, strF, NstrA, NstrB, NstrC, NstrE, NstrF As String
Dim FinalRowB, FinalRowN, count

Set wb = Sheets(1)
Set wn = Sheets(2)

FinalRowB = wb.Range("A900000").End(xlUp).Row
FinalRowN = wn.Range("A900000").End(xlUp).Row

For i = 2 To FinalRowN

    NstrA = wn.Range("A" & i).Value
    NstrA = Trim(NstrA)

    NstrB = wn.Range("B" & i).Value
    NstrB = Trim(NstrB)

    NstrC = wn.Range("C" & i).Value
    NstrC = Trim(NstrC)

    NstrE = wn.Range("E" & i).Value
    NstrE = Trim(NstrE)

    NstrF = wn.Range("F" & i).Value
    NstrF = Trim(NstrF)

    For j = 2 To FinalRowB

        strA = wb.Range("A" & j).Value
        strA = Trim(strA)

        strB = wb.Range("B" & j).Value
        strB = Trim(strB)

        strC = wb.Range("C" & j).Value
        strC = Trim(strC)

        strE = wb.Range("E" & j).Value
        strE = Trim(strE)

        strF = wb.Range("F" & j).Value
        strF = Trim(strF)

            'Check if A-B-C Matched? if yes then check E or F mark yellow if Different
            If strA = NstrA And strB = NstrB And strC = NstrC Then

                If strE <> NstrE Then
                    wn.Range("E" & j).Interior.ColorIndex = 6
                Else

                If strF <> NstrF Then
                    wn.Range("F" & j).Interior.ColorIndex = 6
                Else: End If

                End If

            Else: End If

    Next j
Next i

End Sub

这个不知道哪里错了

Answer 1

您刚刚在测试中弄乱了 End If，它应该在您要着色的范围内 i :

If strA = NstrA And strB = NstrB And strC = NstrC Then
    If strE <> NstrE Then
        wn.Range("E" & i).Interior.ColorIndex = 6
    Else: End If

    If strF <> NstrF Then
        wn.Range("F" & i).Interior.ColorIndex = 6
    Else: End If
Else: End If

这是你的完整代码，已经有点清理了：

Option Explicit
'Option Compare Text
Sub CheckData()
Dim wb, wn As Worksheet
Dim i, j, m
Dim strA, strB, strC, strE, strF, NstrA, NstrB, NstrC, NstrE, NstrF As String
Dim FinalRowB, FinalRowN, count

Set wb = Sheets(1)
Set wn = Sheets(2)
FinalRowB = wb.Range("A" & wb.Rows.count).End(xlUp).Row
FinalRowN = wn.Range("A" & wn.Rows.count).End(xlUp).Row

For i = 2 To FinalRowN
    NstrA = Trim(wn.Range("A" & i).Value)
    NstrB = Trim(wn.Range("B" & i).Value)
    NstrC = Trim(wn.Range("C" & i).Value)
    NstrE = Trim(wn.Range("E" & i).Value)
    NstrF = Trim(wn.Range("F" & i).Value)

    For j = 2 To FinalRowB
        strA = Trim(wb.Range("A" & j).Value)
        strB = Trim(wb.Range("B" & j).Value)
        strC = Trim(wb.Range("C" & j).Value)
        strE = Trim(wb.Range("E" & j).Value)
        strF = Trim(wb.Range("F" & j).Value)

        'Check if A-B-C Matched?
        If strA <> NstrA Or strB <> NstrB Or strC <> NstrC Then
        Else
            'if yes then check E or F and mark yellow if Different
            If strE <> NstrE Then wn.Range("E" & i).Interior.ColorIndex = 6
            If strF <> NstrF Then wn.Range("F" & i).Interior.ColorIndex = 6
        End If
    Next j
Next i

End Sub

Answer 2

或者，更快一点

Sub CheckData()

Dim wb As Worksheet
Dim wn As Worksheet

Dim FinalRowB As Long
Dim FinalRowN As Long

Dim s As String
Dim r As Range
Dim x As Long
Dim v
Set wb = Sheets(1)
Set wn = Sheets(2)

FinalRowB = wb.Range("A900000").End(xlUp).Row
FinalRowN = wn.Range("A900000").End(xlUp).Row
wb.Columns("e").Insert

'concatenate three columns to one
wb.Range("e1").Formula = "=a1&b1&c1"
wb.Range("e1").Copy wb.Range("e1:e" & FinalRowB)

v = wb.Range("e1:g" & FinalRowB) 'copy everything into an array

For Each r In wn.Range("a1:a" & FinalRowN)  'step through second sheet
    s = r & r.Offset(0, 1) & r.Offset(0, 2) 'build search string
    For x = 1 To FinalRowB
        If v(x, 1) = s Then
            If v(x, 2) = r.Offset(0, 4) And v(x, 3) = r.Offset(0, 5) Then
              'fg match
            Else
                r.Offset(0, 4).Interior.ColorIndex = 6
                r.Offset(0, 5).Interior.ColorIndex = 6
            End If

        End If
    Next x
Next r
wb.Columns("e").Delete  'tidy up afterwards
End Sub

如果不同，则匹配两张纸上的数据颜色为黄色

Match data on two sheets color yellow if different

excel

vba

compare

match