用于比较两列和颜色突出显示单元格差异的 VBA 宏

VBA macro to compare two columns and color highlight cell differences

提问by Jose Leon

I wanted to color highlight cells that are different from each other; in this case colA and colB. This function works for what I need, but looks repetitive, ugly, and inefficient. I'm not well versed in VBA coding; Is there a more elegant way of writing this function?

我想为彼此不同的高亮单元着色；在这种情况下 colA 和 colB。此功能适用于我需要的功能，但看起来重复、丑陋且效率低下。我不精通 VBA 编码；有没有更优雅的方式来编写这个函数？

EDITWhat I'm trying to get this function to do is: 1. highlight cells in ColA that are different or not in ColB 2. highlight cells in ColB that are different or not in ColA

编辑我试图让这个功能做的是： 1. 突出显示 ColA 中不同或不在 ColB 中的单元格 2. 突出显示 ColB 中不同或不在 ColA 中的单元格

    Sub compare_cols()

    Dim myRng As Range
    Dim lastCell As Long

    '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("Sheet1").Range("B2:B" & lastRow).Cells
            c.Interior.Color = vbRed
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbWhite
                Exit For
            End If
        Next
    Next

    For Each c In Worksheets("Sheet1").Range("B2:B" & lastRow).Cells
        For Each d In Worksheets("Sheet1").Range("A2:A" & lastRow).Cells
            c.Interior.Color = vbRed
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbWhite
                Exit For
            End If
        Next
    Next

Application.ScreenUpdating = True

End Sub

回答by Lopsided

Ah yeah that's cake I do it all day long. Actually your code looks pretty much like the way I'd do it. Although, I opt to use looping through integers as opposed to using the "For Each" method. The only potential problems I can see with your code is that ActiveSheet may not always be "Sheet1", and also InStr has been known to give some issues regarding the vbTextCompare parameter. Using the given code, I would change it to the following:

啊，是的，这就是我整天都在做的蛋糕。实际上你的代码看起来很像我做的方式。尽管如此，我选择使用循环遍历整数而不是使用“For Each”方法。我在您的代码中看到的唯一潜在问题是 ActiveSheet 可能并不总是“Sheet1”，而且已知 InStr 会给出一些有关 vbTextCompare 参数的问题。使用给定的代码，我会将其更改为以下内容：

Sub compare_cols()

    'Get the last row
    Dim Report As Worksheet
    Dim i As Integer, j As Integer
    Dim lastRow As Integer

    Set Report = Excel.Worksheets("Sheet1") 'You could also use Excel.ActiveSheet _
                                            if you always want this to run on the current sheet.

    lastRow = Report.UsedRange.Rows.Count

    Application.ScreenUpdating = False

    For i = 2 To lastRow
        For j = 2 To lastRow
            If Report.Cells(i, 1).Value <> "" Then 'This will omit blank cells at the end (in the event that the column lengths are not equal.
                If InStr(1, Report.Cells(j, 2).Value, Report.Cells(i, 1).Value, vbTextCompare) > 0 Then
                    'You may notice in the above instr statement, I have used vbTextCompare instead of its numerical value, _
                    I find this much more reliable.
                    Report.Cells(i, 1).Interior.Color = RGB(255, 255, 255) 'White background
                    Report.Cells(i, 1).Font.Color = RGB(0, 0, 0) 'Black font color
                    Exit For
                Else
                    Report.Cells(i, 1).Interior.Color = RGB(156, 0, 6) 'Dark red background
                    Report.Cells(i, 1).Font.Color = RGB(255, 199, 206) 'Light red font color
                End If
            End If
        Next j
    Next i

    'Now I use the same code for the second column, and just switch the column numbers.
    For i = 2 To lastRow
        For j = 2 To lastRow
            If Report.Cells(i, 2).Value <> "" Then
                If InStr(1, Report.Cells(j, 1).Value, Report.Cells(i, 2).Value, vbTextCompare) > 0 Then
                    Report.Cells(i, 2).Interior.Color = RGB(255, 255, 255) 'White background
                    Report.Cells(i, 2).Font.Color = RGB(0, 0, 0) 'Black font color
                    Exit For
                Else
                    Report.Cells(i, 2).Interior.Color = RGB(156, 0, 6) 'Dark red background
                    Report.Cells(i, 2).Font.Color = RGB(255, 199, 206) 'Light red font color
                End If
            End If
        Next j
    Next i

Application.ScreenUpdating = True

End Sub

Things I did differently:

我做的不同的事情：

1. I used my integer method described above (as opposed to the 'for each' method).
2. I defined the worksheet as an object variable.
3. I used vbTextCompare instead of its numerical value in the InStr function.
4. I added an if statement to omit blank cells. Tip: Even if only one column in the sheet is extra long (e.g., cell D5000 was accidentally formatted), then the usedrange for all columns is considered 5000.
5. I used rgb codes for the colors (it's just easier for me since I have a cheat sheet pinned to the wall next to me in this cubicle haha).

1. 我使用了上面描述的整数方法（而不是“for each”方法）。
2. 我将工作表定义为对象变量。
3. 我在 InStr 函数中使用了 vbTextCompare 而不是它的数值。
4. 我添加了一个 if 语句来省略空白单元格。提示：即使工作表中只有一列超长（例如，单元格 D5000 被意外格式化），所有列的 usedrange 也被视为 5000。
5. 我使用 rgb 代码来表示颜色（这对我来说更容易，因为我在这个隔间里旁边的墙上有一个备忘单，哈哈）。

Well that about sums it up. Good luck with your project!

嗯，总结一下。祝你的项目好运！

回答by Madhushree

'Compare the two columns and highlight the difference

'比较两列并突出显示差异

    Sub CompareandHighlight()



        Dim n As Integer
        Dim valE As Double
        Dim valI As Double
        Dim i As Integer

        n = Worksheets("Indices").Range("E:E").Cells.SpecialCells(xlCellTypeConstants).Count
        Application.ScreenUpdating = False

        For i = 2 To n
        valE = Worksheets("Indices").Range("E" & i).Value
        valI = Worksheets("Indices").Range("I" & i).Value

            If valE = valI Then

            Else:

               Worksheets("Indices").Range("E" & i).Font.Color = RGB(255, 0, 0)

            End If
        Next i


    End Sub

' I hope this helps you

' 我希望这可以帮助你