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