ikboy

¦^´_ 1# free72921

1. Sub zz()
   
2. Dim a(1), b, c, d, s$, j%, ln%
   
3. a(0) = Split([b3].Value, ",")
   
4. a(1) = Split([c3].Value, ",")
   
5. For i = 0 To UBound(a)
   
6.     If i Then n = 0 Else n = 1
   
7.     b = a(i)
   
8.     For Each c In a(n)
   
9.         b = Filter(b, c, 0)
   
10.     Next
    
11.     If UBound(b) >= 0 Then
    
12.         s = Cells(3, i + 2).Value
    
13.         For Each c In b
    
14.             ln = Len(c)
    
15.             j = Application.WorksheetFunction.Find(c, s)
    
16.             Cells(3, i + 2).Characters(j, ln).Font.Color = vbRed
    
17.         Next
    
18.     End If
    
19. Next
    
20. End Sub

½Æ»s¥N½X

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