3

我想为彼此不同的单元格着色；在这种情况下 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
4

2 回答 2

4

啊，是的，那是蛋糕，我整天都在做。实际上，您的代码看起来很像我这样做的方式。虽然，我选择使用整数循环而不是使用“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 代码作为颜色（这对我来说更容易，因为我在这个隔间里有一张备忘单固定在我旁边的墙上哈哈）。

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

于 2013-01-11T15:22:51.790 回答
1

'比较两列并突出差异

    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

' 我希望这可以帮助你

于 2018-11-21T09:52:33.043 回答