返回列表 上一主題 發帖

[發問] 2儲存格中字串差異顯示

Sub test()
    Set xB = [B3]
    Set xC = [C3]
    While xB <> ""
        If xB.Value <> xC.Value Then
            Call NotFindChar(xB, xC)
            Call NotFindChar(xC, xB)
        End If
        Set xB = xB(2, 1)
        Set xC = xC(2, 1)
    Wend
    Debug.Print "time", Time
End Sub

Sub NotFindChar(xC, xS)
    ArrC = Split(xC.Value, ",")
    For i = 0 To UBound(ArrC)
        If InStr("," & xS & ",", "," & ArrC(i) & ",") = 0 Then
            nS = InStr("," & xC & ",", "," & ArrC(i) & ",")
            nL = Len(ArrC(i))
            With xC.Characters(Start:=nS, Length:=nL).Font
                .FontStyle = "粗體"
                .Color = vbRed '紅色 -16777024
            End With
        End If
    Next
End Sub
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

回復 5# samwang
你比較細心,確實有可能2個號碼在前後不同地方

我原先程式修改位置 *1 *2 *3
Sub test()
    ' 清除字顏色及粗體
    With Range("B3:C" & [C65536].End(xlUp).Row).Font
        .ColorIndex = xlAutomatic
        .Bold = False
    End With
   
    Set xB = [b3]
    Set xC = [c3]
    While xB <> ""
        If xB.Value <> xC.Value Then
            Call NotFindChar(xB, xC)
            Call NotFindChar(xC, xB)
        End If
        Set xB = xB(2, 1)
        Set xC = xC(2, 1)
    Wend
    Debug.Print "time", Time
End Sub

Sub NotFindChar(xC, xS)
    ArrC = Split(xC.Value, ",")
    nStart = 1 '*1
    For i = 0 To UBound(ArrC)
        If InStr("," & xS & ",", "," & ArrC(i) & ",") = 0 Then
            nS = InStr(nStart, "," & xC & ",", "," & ArrC(i) & ",") '*2
            nL = Len(ArrC(i))
            ' Range("b3").Characters(pos, L).Font.ColorIndex = 3
            ' Cells(3, i + 2).Characters(j, ln).Font.Color = vbRed
            With xC.Characters(Start:=nS, Length:=nL).Font
                .FontStyle = "粗體"
                .Color = vbRed '紅色 -16777024
            End With
        End If
        nStart = nStart + nL + 1 '*3
    Next
End Sub
{...} 表示需要用 CTRL+SHIFT+ENTER 三鍵輸入公式

TOP

        靜思自在 : 站在半路,比走到目標更辛苦。
返回列表 上一主題