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

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

Answer 2

'比较两列并突出差异

    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

'希望对你有帮助