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

Question

我想对彼此不同的单元格进行颜色突出显示；在本例中是 colA 和 colB。这个函数可以满足我的需要，但看起来重复、丑陋且效率低下。我不太熟悉 VBA 编码；有没有更优雅的方式来编写这个函数？

编辑我试图让这个函数做的是: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

Answer 1

啊，是的，那是蛋糕，我一整天都在做。实际上你的代码看起来很像我的做法。尽管如此，我选择使用循环整数而不是使用“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

我做的不同的事情:

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

嗯，这就是总结。祝您的项目顺利!