samwang

¦^´_ 1# free72921

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test()
Dim xD, xD1, Ar(), Ar1(), T$, ky, L%, i&, j%, n%, n1%
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
xR = Range("b3")
For j = 0 To UBound(Split(xR, ","))
    T = Split(xR, ",")(j): xD(T) = 1
Next
xR1 = Range("c3")
For j = 0 To UBound(Split(xR1, ","))
    T = Split(xR1, ",")(j): xD1(T) = 1
Next
For Each ky In xD
If xD1(ky) <> 1 Then: ReDim Preserve Ar(n): Ar(n) = ky: n = n + 1
Next
For Each ky In xD1
If xD(ky) <> 1 Then: ReDim Preserve Ar1(n1): Ar1(n1) = ky: n1 = n1 + 1
Next
If n1 > 0 Then
    For j = 0 To UBound(Ar1)
        T = Ar1(j): L = Len(T): pos = InStr(Range("c3"), T)
        Range("c3").Characters(pos, L).Font.ColorIndex = 3
    Next
End If
If n > 0 Then
    For j = 0 To UBound(Ar)
        T = Ar(j): L = Len(T): pos = InStr(Range("b3"), T)
        Range("b3").Characters(pos, L).Font.ColorIndex = 3
    Next
End If
End Sub

samwang

½Ð±Ð¦U¦ì¤j¤j¡A¦pªG¦P®É¦³2­Ó¥H¤Wªº®t²§¡A«á¾Ç¥Ø«e¥u¯à±N²Ä1­Ó®t²§¤ÏÃC¦â(2#µ{¦¡½X)¡A
¤£ª¾¦U¦ì¤j¤j¬O§_¥i¥H±N¨ä¥Lªº®t²§¤]¤@¨Ö¤ÏÃC¦â? ·PÁÂ
¦pªþ¹Ï¡A²Ä2­ÓR777­n¤ÏÃC¦â¡C

samwang

¦^´_ 9# ML089

§Ú¬O«Ü²Ê¤ßªº¤H¡A¥u¬O­è¦n¬Ý¨ì¦¹°ÝÃD¡A
¥t¥~¡A¬Ý¨ìª©¥D¸Ñµª¡A¤]¾Ç²ß¤@¤U¦Ó·Q¨ì¸Ñªk¡A·PÁ¡C

Sub test()
Dim xD, xD1, Ar(), Ar1(), T$, ky, L%, i&, j%, n%, n1%, xP%, xP1
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
xR = Range("b3")
For j = 0 To UBound(Split(xR, ","))
    T = Split(xR, ",")(j): xD(T) = xD(T) + 1
Next
xR1 = Range("c3")
For j = 0 To UBound(Split(xR1, ","))
    T = Split(xR1, ",")(j): xD1(T) = xD1(T) + 1
Next
For Each ky In xD
If Not xD1.exists(ky) Then: ReDim Preserve Ar(n): Ar(n) = ky: n = n + 1
Next
For Each ky In xD1
If Not xD.exists(ky) Then: ReDim Preserve Ar1(n1): Ar1(n1) = ky: n1 = n1 + 1
Next
If n1 > 0 Then
    For j = 0 To UBound(Ar1)
        T = Ar1(j): L = Len(T)
        For j1 = 1 To xD1(T)
            If j1 = 1 Then
                pos = InStr(Range("c3"), T)
            Else
                pos = InStr(xP, Range("c3"), T)
            End If
            Range("c3").Characters(pos, L).Font.ColorIndex = 3
            xP = pos + 2
        Next
    Next
End If
If n > 0 Then
    For j = 0 To UBound(Ar)
        T = Ar(j): L = Len(T)
        For j1 = 1 To xD(T)
            If j1 = 1 Then
                pos = InStr(Range("b3"), T)
            Else
                pos = InStr(xP1, Range("b3"), T)
            End If
            Range("b3").Characters(pos, L).Font.ColorIndex = 3
            xP1 = pos + 2
        Next
    Next
End If
End Sub

samwang

¦^´_ 6# free72921

¨Ò¦p¡G
¸õ¥X¸ß°Ýµøµ¡¡i½Ð¿ï¾Ü½d³òA¡j
¸õ¥X¸ß°Ýµøµ¡¡i½Ð¿ï¾Ü½d³òB¡j
¦A¥H³Q¿ï©wªº2­Ó½d³ò¶}©l¶i¦æ¤ñ¹ï
>> ¦p¤U¡A½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Sub test2()
Dim R, xR, xR1, xD, xD1, Ar(), Ar1(), ky
Dim T$, L%, i&, j%, n%, n1%, xP%, xP1%, pos%
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = CreateObject("Scripting.Dictionary")
On Error Resume Next
Set xR = Application.InputBox("½Ð¿ï¾ÜRange:", Type:=8)
Set xR1 = Application.InputBox("½Ð¿ï¾ÜRange:", Type:=8)

For Each R In xR: For j = 0 To UBound(Split(R, ","))
    T = Split(R, ",")(j): xD(T) = xD(T) + 1
Next j: Next R
For Each R In xR1: For j = 0 To UBound(Split(R, ","))
        T = Split(R, ",")(j): xD1(T) = xD1(T) + 1
Next j: Next R
For Each ky In xD
If Not xD1.exists(ky) Then: ReDim Preserve Ar(n): Ar(n) = ky: n = n + 1
Next
For Each ky In xD1
If Not xD.exists(ky) Then: ReDim Preserve Ar1(n1): Ar1(n1) = ky: n1 = n1 + 1
Next

If n1 > 0 Then
    For j = 0 To UBound(Ar1)
        For Each R In xR1
            T = Ar1(j): L = Len(T): xP = 1
            For j1 = 1 To xD1(T)
                pos = InStr(xP, R, T, 0)
                If pos > 0 Then
                    R.Characters(pos, L).Font.ColorIndex = 3
                    xP = pos + 2
                End If
            Next j1
        Next R
    Next j
End If
If n > 0 Then
    For j = 0 To UBound(Ar)
        For Each R In xR
            T = Ar(j): L = Len(T): xP1 = 1
            For j1 = 1 To xD(T)
                pos = InStr(xP1, R, T, 0)
                If pos > 0 Then
                    R.Characters(pos, L).Font.ColorIndex = 3
                    xP1 = pos + 2
                End If
            Next j1
        Next R
    Next j
End If
End Sub