ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] 2Àx¦s®æ¤¤¦r¦ê®t²§Åã¥Ü

[µo°Ý] 2Àx¦s®æ¤¤¦r¦ê®t²§Åã¥Ü

¥Ñ©ó¤u§@¤W°¸º¸·|»Ý­n¤ñ¹ï2Àx¦s®æ¤¤ªº¦r¦ê®t²§¡A
¦r¦ê¼Æ¶qÃe¤j®É«D±`¶Ë²´¡A½Ð°Ý¦U¦ì«e½ú¬O§_¦³¸û
¦nªº¤è¦¡¤ñ¹ï2Àx¦s®æ¤¤¦r¦êªº®t²§¨ÃÅã¥Ü¥X¨Ó¡C
·PÁ¦U¦ì«e½ú


¦r¦ê®t²§.zip (7.17 KB)

¦^´_ 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

TOP

¦^´_ 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

TOP

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
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-8-30 07:30 ½s¿è

½Ð±Ð¦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

Â^¨ú11.PNG (4.88 KB)

Â^¨ú11.PNG

TOP

·PÁ¦U¦ì«e½úÀ°¦£¡A¤T¦ì«e½úªºµ{¦¡³£¥i¥H¤ñ¹ï¥X®t²§¡C
¦ý2¼Ó«e½úªºµ{¦¡¥u·|¶]¥X²Ä¤@­Ó®t²§¡A«áÄò¦A¦³®t²§«hµLªkÅã¥Ü¡A
¥t¥~2¦ì«e½úªºµ{¦¡³£¥i¥HÅã¥Ü¥X¨C¤@­Ó®t²§ÂI¡C

¥t¦³¤@¨Æ¬Û¨D¡A¹³³o¼Ëªº¦r¦ê®t²§¬O§_¦³¥i¯à¥H¥t¤@ºØ¤è¦¡°õ¦æ¡A
¦]¬°¨C¦¸¤ñ¹ï®É·|¦³¦h­ÓÀx¦s®æ¦P®É¶i¦æ¡C

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

TOP

google"EXCEL°g"  blog  ©Îgoogleºô§}:https://hcm19522.blogspot.com/

TOP

¦^´_ 6# 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. Set d = CreateObject("scripting.dictionary")
  6. For i = 0 To UBound(a)
  7.     If i Then n = 0 Else n = 1
  8.     For Each c In a(i)
  9.         d(c) = ""
  10.     Next
  11.     s = Cells(3, i + 2).Value
  12.     For Each c In a(n)
  13.         If Not d.exists(c) Then
  14.             ln = Len(c)
  15.             j = InStr(s, c)
  16.             Cells(3, i + 2).Characters(j, ln).Font.Color = vbRed
  17.         End If
  18.     Next
  19.     d.RemoveAll
  20. Next
  21. End Sub
½Æ»s¥N½X

TOP

¦^´_ 5# samwang
§A¤ñ¸û²Ó¤ß¡A½T¹ê¦³¥i¯à2­Ó¸¹½X¦b«e«á¤£¦P¦a¤è

§Ú­ì¥ýµ{¦¡­×§ï¦ì¸m *1 *2 *3
Sub test()
    ' ²M°£¦rÃC¦â¤Î²ÊÅé
    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
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¥»©«³Ì«á¥Ñ samwang ©ó 2021-8-30 11:45 ½s¿è

¦^´_ 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

TOP

        ÀR«ä¦Û¦b : Ä@­n¤j¡B§Ó­n°í¡B®ð­n¬X¡B¤ß­n²Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD