Question

我想要突出显示彼此不同的细胞;在这种情况下colA和colB。这个功能适用于我需要的东西，但看起来重复，丑陋和低效。我不太熟悉VBA编码;有没有更优雅的方式来编写这个函数？

修改我试图让这个功能做的是： 1.突出ColA中不同或不同的ColA细胞 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

我做的事情不同：

我使用了上面描述的整数方法（而不是'for each'方法）。
我将工作表定义为对象变量。
我在InStr函数中使用了vbTextCompare而不是它的数值。
我添加了一个if语句来省略空白单元格。提示：即使只有一个片材中的列太长（例如，细胞D5000是意外的格式化），然后所有列的usedrange被认为是5000。
我使用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

'希望对您有帮助

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

2 个答案: