如果不同,将两张纸上的数据匹配为黄色

时间:2015-11-26 15:35:23

标签: excel vba excel-vba compare match

我正在尝试检查两张表格上的数据。

逻辑:

如果Sheet2上的Col Col ABC数据与Sheet1上任何行相同列的数据匹配。然后检查两张纸上的col E和col F,如果{上的任何数据不同,则将它们着色为黄色{1}}

代码:

Sheet2

不知道我错在哪里。

2 个答案:

答案 0 :(得分: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

答案 1 :(得分:0)

或者,加快一点

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