Заполнение зеленого цвета до совпадающих значений и красного цвета до разных значений на двух листах одного и того же файла Excel - PullRequest
0 голосов
/ 28 февраля 2020

Я хочу заполнить зеленым цветом, если значение одинаково в обоих файлах (Sheet1 и Sheet1_Compare), если не совпадает с заливкой красным цветом. И файл Excel содержит несколько листов с их листами сравнения в одном Excel. Титульный лист и редакция должны быть исключены.

 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

1 Ответ

0 голосов
/ 03 марта 2020

Внесите следующие изменения. Это должно работать.

  1. Поскольку вы сравниваете с "_Compare" листами, вы должны исключить эти листы из l oop.

    Измените это: 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")

  2. Изменить Sheets(ws) на Sheets(ws.Name)

  3. Изменить 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

РЕДАКТИРОВАТЬ : код для проверки наличия или отсутствия листа.

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")
...