excel - 如何在整个工作表中循环比较代码的文本？

Question

我正在将两个单元格（A1 和 B1）与几乎相同的文本进行比较，并希望突出显示 C1 中不同的文本。我找到了只比较两个单元格的代码，但是在我的整个工作表中循环它时遇到了麻烦。任何帮助将不胜感激！

Sub CompareInColor()

    ActiveSheet.Range("C1").Value = ActiveSheet.Range("A1").Value
    
    For i = 1 To Len(ActiveSheet.Range("A1").Value)
        If (ActiveSheet.Range("A1").Characters(i, 1).Text <> ActiveSheet.Range("B1").Characters(i, 1).Text) Then
            ActiveSheet.Range("C1").Characters(i, 1).Font.Color = RGB(255, 0, 0)
        End If
    Next i

End Sub

标签： excelvba

Answer 1

比较字符

• 尝试尽可能少地访问工作表。仍然可以例如通过使用阵列来提高效率。

范围版本

Option Explicit

Sub CompareInColor()

    With ActiveSheet ' With Thisworkbook.worksheets("Sheet1") ' is safer.
        
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        Dim cel As Range
        Dim CurrLen As Long
        Dim Remainder As Long
        Dim i As Long
        Dim j As Long
        Dim str1 As String
        Dim str2 As String
        
        For i = 1 To LastRow
            
            str1 = .Cells(i, "A").Value
            str2 = .Cells(i, "B").Value
            
            If Len(str1) < Len(str2) Then
                CurrLen = Len(str1)
                Remainder = 0
            Else
                CurrLen = Len(str2)
                Remainder = Len(str1) - CurrLen
            End If
            
            Set cel = .Cells(i, "C")
            cel.Value = str1
            
            For j = 1 To CurrLen
                If Mid(str1, j, 1) <> Mid(str2, j, 1) Then
                    cel.Characters(j, 1).Font.Color = RGB(255, 0, 0)
                End If
            Next j
            
            If Remainder > 0 Then
                For j = CurrLen + 1 To CurrLen + 1 + Remainder
                    cel.Characters(j, 1).Font.Color = RGB(255, 0, 0)
                Next j
            End If
        
        Next i
        
    End With

End Sub

阵列版本

Sub CompareInColorArray()

    With ActiveSheet ' With Thisworkbook.worksheets("Sheet1") ' is safer.
        
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        Dim Data As Variant
        Data = .Cells(1, "A").Resize(LastRow, 2)
        
        Dim cel As Range
        Dim CurrLen As Long
        Dim Remainder As Long
        Dim i As Long
        Dim j As Long
        Dim str1 As String
        Dim str2 As String
        
        For i = 1 To LastRow
            
            str1 = Data(i, 1)
            str2 = Data(i, 2)
            
            If Len(str1) < Len(str2) Then
                CurrLen = Len(str1)
                Remainder = 0
            Else
                CurrLen = Len(str2)
                Remainder = Len(str1) - CurrLen
            End If
            
            Set cel = .Cells(i, "C")
            cel.Value = str1
            
            For j = 1 To CurrLen
                If Mid(str1, j, 1) <> Mid(str2, j, 1) Then
                    cel.Characters(j, 1).Font.Color = RGB(255, 0, 0)
                End If
            Next j
            
            If Remainder > 0 Then
                For j = CurrLen + 1 To CurrLen + 1 + Remainder
                    cel.Characters(j, 1).Font.Color = RGB(255, 0, 0)
                Next j
            End If
        
        Next i
        
    End With

End Sub