VBA - 用于比较两列的Excel

Question

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

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

见我下面

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