在同一 excel 文件的两张表中，将绿色填充到匹配值，将红色填充到不同值

Question

如果两个文件（Sheet1 和 Sheet1_Compare）中的值相同，我想填充绿色，如果不匹配，则填充红色。 Excel 文件包含多个 sheet，它们的比较 sheet 在相同的 excel 中。应排除封面 sheet 和修订 sheet。

 Public Sub Differentiate()

     Dim ws As Worksheet
     Dim wsRow As Integer
     Dim wsCol As Integer
     Dim i As Integer
     Dim j As Integer


    For Each ws In Worksheets

        If ws.Name <> "Cover Sheet" Or ws.Name <> "Revision Sheet" Then
            If InStr(LCase(ws.Name), LCase("Compared")) = 0 Then
            With ws.UsedRange
                wsRow = .Rows.Count
                wsCol = .Columns.Count
            End With
            for i = 1 To wsRow
                for j = 1 To wsCol
                If Sheets(ws).Cells(i,j) = Sheet(ws + "_Compare").Cells(i,j) Then
                    Sheets(ws).Cells(i,j).Interior.ColorIndex = 4 'Green
                    Sheets(ws + "_Compare").Cells(i,j).Interior.ColorIndex = 4 'Green
                Else
                    Sheets(ws).Cells(i,j).Interior.ColorIndex = 3 'Red
                    Sheets(ws + "_Compare").Cells(i,j).Interior.ColorIndex = 3 'Red
                End If
                Next j
            Next i
            End If
        End If
    Next ws

    End Sub

Answer 1

进行以下更改。它应该有效。

当您与 "_Compare" sheet 进行比较时，您应该从循环中排除这些 sheet。

改变这个：If ws.Name <> "Cover Sheet" Or ws.Name <> "Revision Sheet" 至

If ws.Name <> "Cover Sheet" And ws.Name <> "Revision Sheet" And Not (ws.Name Like "*_Compare")
将Sheets(ws)改为Sheets(ws.Name)
将Sheet(ws + "_Compare")更改为Sheets(ws.Name + "_Compare")

编辑代码：

 Public Sub Differentiate()
 Dim ws As Worksheet
 Dim wsRow As Integer
 Dim wsCol As Integer
 Dim i As Integer
 Dim j As Integer

Set ws = ActiveSheet
For Each ws In Worksheets
    If ws.Name <> "Cover Sheet" And ws.Name <> "Revision Sheet" And Not (ws.Name Like "*_Compare") Then
        If InStr(LCase(ws.Name), LCase("Compared")) = 0 Then
            With ws.UsedRange
                wsRow = .Rows.Count
                wsCol = .Columns.Count
            End With
            For i = 1 To wsRow
                For j = 1 To wsCol
                    If Sheets(ws.Name).Cells(i, j) = Sheets(ws.Name + "_Compare").Cells(i, j) Then
                        Sheets(ws.Name).Cells(i, j).Interior.ColorIndex = 4 'Green
                        Sheets(ws.Name + "_Compare").Cells(i, j).Interior.ColorIndex = 4 'Green
                    Else
                        Sheets(ws.Name).Cells(i, j).Interior.ColorIndex = 3 'Red
                        Sheets(ws.Name + "_Compare").Cells(i, j).Interior.ColorIndex = 3 'Red
                    End If
                Next j
            Next i
        End If
    End If
Next ws
End Sub

编辑：检查sheet是否存在的代码。

Option Explicit

Function WorksheetExists(ByVal WorksheetName As String) As Boolean
Dim Sht As Worksheet

    For Each Sht In ThisWorkbook.Worksheets
        If Application.Proper(Sht.Name) = Application.Proper(WorksheetName) Then
            WorksheetExists = True
            Exit Function
        End If
    Next Sht
WorksheetExists = False
End Function

然后按以下方式调用上面的函数：

MsgBox WorksheetExists("Sheet1_Compare")

在同一 excel 文件的两张表中，将绿色填充到匹配值，将红色填充到不同值

Filling green color to matched values and red color to different values in two sheets of same excel file

excel

vba

background-color

difference