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

VBA - 用于比较两列的Excel

2 个答案: