VBA – 用于比较两列的Excel

我创build了一个VBA，它将比较两张相同的Excel文件。 如果工作表A中的数据不准确，则会将该行的颜色更改为红色，如果颜色发生更改，我也应用了filter。

现在的问题是它没有以适当的方式工作。 就像如果我的数据是相同的，那么它也是应用filter。

看到我的代码如下

Sub Validate_Metadata() Dim myRng As Range Dim lastCell As Long Dim flag As Boolean 'Get the last row Dim lastRow As Integer lastRow = ActiveSheet.UsedRange.Rows.Count 'Debug.Print "Last Row is " & lastRow Dim c As Range Dim d As Range Application.ScreenUpdating = False For Each c In Worksheets("Sheet1").Range("A2:A" & lastRow).Cells For Each d In Worksheets("Sheet2").Range("A2:A" & lastRow).Cells c.Interior.Color = vbRed flag = False If (InStr(1, d, c, 1) > 0) Then c.Interior.Color = vbWhite Exit For End If Next Next If (flag <> True) Then ActiveSheet.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=RGB(255, 0 _ , 0), Operator:=xlFilterCellColor End If Application.ScreenUpdating = True End Sub 

谢谢

Answer 1

尝试这个：

 Sub Validate_Metadata() Dim myRng As Range Dim lastCell As Long Dim flag As Boolean 'Get the last row Dim lastRow As Integer Dim localFlag As Boolean lastRow = ActiveSheet.UsedRange.Rows.Count 'Debug.Print "Last Row is " & lastRow Dim c As Range Dim d As Range Application.ScreenUpdating = False flag = True For Each c In Worksheets("Sheet1").Range("A2:A" & lastRow).Cells localFlag = False For Each d In Worksheets("Sheet2").Range("A2:A" & lastRow).Cells c.Interior.Color = vbRed If (InStr(1, d, c, 1) > 0) Then c.Interior.Color = vbWhite localFlag = True Exit For End If Next flag = flag And localFlag Next If (flag <> True) Then ActiveSheet.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=RGB(255, 0 _ , 0), Operator:=xlFilterCellColor End If Application.ScreenUpdating = True End Sub 

Answer 2

首先将单元格的内部颜色更改为红色 ，然后检查条件。 如果它匹配，然后再次改变细胞颜色为白色 。 我想这不是一个好方法。 相反，首先检查条件，然后只有在没有匹配时才更改颜色。

像这样的东西：

 Sub Validate_Metadata() Dim myRng As Range Dim lastCell As Long Dim flag As Boolean, found As Boolean 'new boolean variable declared 'Get the last row Dim lastRow As Integer lastRow = ActiveSheet.UsedRange.Rows.Count Dim c As Range Dim d As Range Application.ScreenUpdating = False For Each c In Worksheets("Sheet11").Range("A2:A" & lastRow).Cells found = False 'set flag here for cell For Each d In Worksheets("Sheet12").Range("A2:A" & lastRow).Cells If (InStr(1, d, c, 1) > 0) Then c.Interior.Color = vbWhite found = True Exit For End If Next d If Not found Then 'if cell do not match change the color c.Interior.Color = vbRed If Not flag Then flag = True 'change filter flag to true just once End If Next c If flag Then 'check for filter flag ActiveSheet.Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:=RGB(255, 0 _ , 0), Operator:=xlFilterCellColor End If Application.ScreenUpdating = True End Sub