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

[µo°Ý] ¤½¦¡µ{¦¡½X¤Æ

Sub ¼Ð¥Ü©³¦â()
Dim xS As Worksheet, R&, Arr, A, xD, xU As Range, N&
Set xD = CreateObject("Scripting.Dictionary")
For Each xS In Sheets(Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8"))
    R = xS.[b65536].End(xlUp).Row
    xS.[d2].Resize(R, 7).Interior.ColorIndex = xlNone
    Set xU = xS.[c2]
    For j = 1 To 7:   xD(Val(xS.Cells(R, j + 12))) = 1: Next j
    Arr = xS.[d1].Resize(R, 7)
    For i = 2 To R:  For j = 1 To 7
        For Each A In Split(Arr(i, j), ",")
            If xD(Val(A)) > 0 Then Set xU = Union(xS.Cells(i, j + 3), xU): Exit For
        Next A
    Next j: Next i
    '-------------------------------
    R = xS.[a65536].End(xlUp).Row
    xS.[a4].Resize(R).Interior.ColorIndex = xlNone
    Arr = xS.[a1].Resize(R)
    For i = 4 To R
        If xD(Val(Arr(i, 1))) > 0 Then Set xU = Union(xS.Cells(i, 1), xU)
    Next i
    xU.Interior.ColorIndex = 8
    xS.[c2].Interior.ColorIndex = xlNone
    xD.RemoveAll: N = 0
Next xS
End Sub

TOP

¦^´_ 31# ­ã´£³¡ªL
ª©¥D :
§Ú¥»¨Ó¬O·Q¬ã²ß¦U¦ì¤j¤jªº»yªk¡A©Ò¥H°w¹ï¦U¤Hªº»yªk¡A§Ú¦³¤£ÁA¸Ñªº¦a¤èÀWÀWµo°Ý~µ¹¤j®a²K³Â·Ð¤F~©êºp!

·PÁ±z±N³o¤G¬qµ{¦¡¸É»ô¡C
±z¤Ó¼F®`¤F~¥þÀÉ°õ¦æ®É¶¡¤£¨ì2¬í

¸U¤À·PÁ±zªº«ü¾É©MÀ°¦£

TOP

¦^´_ 29# ziv976688

¥ý¦^ÂаÝÃD 2
±Æ§Ç¿ù»~­×¥¿¡AxD.Count = 1®É¡A±Æ§Ç½d³òÅܦ¨¾ã­Óªí®æ³y¦¨¿ù»~

Sub ¾l¼Æ¦U¨ú1()
Dim xD As Object, xS As Worksheet, xR As Range, SP
   
    Set xD = CreateObject("Scripting.Dictionary")
    For Each xS In Sheets(Split("·Ç2¶i3 ·Ç3¶i4 ·Ç4¶i5 ·Ç5¶i6 ·Ç6¶i7 ·Ç7¶i8")) '¨úªí®æ
            For Each xR In xS.Range("D2:J" & xS.[B65536].End(xlUp).Row) '¨úÀx¦s®æ
            For Each SP In Split(xR, ",") '¤À¶}¼Æ¦r
                If Val(SP) > 0 Then xD(Val(SP)) = "" '¦r¨å²Õ¦X
            Next
        Next
        xS.[A2:A110].ClearContents '²M°£Àx¦s®æ¤º®e
        xS.[a2] = xD.Count & "­Ó": xS.[A3] = "¸¹½X"
        N = xD.Count: If N = 0 Then Exit For
        With xS.[A4].Resize(N)
            .Value = Application.Transpose(xD.keys)
            '±Æ§Ç¿ù»~­×¥¿¡AxD.Count = 1®É¡A±Æ§Ç½d³òÅܦ¨¾ã­Óªí®æ³y¦¨¿ù»~
            If N > 1 Then .Sort key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
            xD.RemoveAll
        End With
    Next
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 33# ML089
ª©¥D :
¾l¼Æ¦U¨ú1´ú¸Õ¦¨¥\
ÁÂÁ±z­@¤ß«ü¾É~·P®¦
±zªº¥[µù~Åý§Ú¨ü¯q¨}¦h

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-7-27 06:18 ½s¿è

¦^´_ 33# ML089
ª©¥D :
§Ú·Q±zªº"¼Ð¥Ü©³¦â"¤§µ{¦¡½XÀ³¸Ó¬O¥¿¸Ñ~
¦]¬°§Úµo²{Bug¥X¦b¦C12 xS.[a2] = xD.Count & "­Ó"¡A
¥¦·|Åý"·Ç6¶i7"ªºA2Åã¥Ü0­Ó¡A¦ý"·Ç7¶i8"ªºA2«oÅã¥Ü""¡A¥B¼Ð¥ÜÂÅ©³¦â¡F
¦pªG§Ú¦b¦C20´¡¤J xS.[a2] = Application.Count(xS.[A4:A52]) & "­Ó" ´ú¸Õ~
"·Ç7¶i8"ªºA2¤§ÂŦâ¼Ð¥Ü´N·|®ø¥¢¡C¦ýÁÙ¬OÅã¥Ü""(¤£¬OÅã¥Ü0­Ó)~
¥i¨£´¡¤J¦C20¤]¤£¬O§¹¥þ¥Í®Ä(¥¿½T)~¬O¤°»ò¦]?§Ú¤]¤£À´¡C
¦]¬°µ{¦¡ªº¬yµ{Ãö«Y¡A§Ú¬J¤£¯à²¾°£¦C12¡A¤]¤£ª¾¹D«ç»ò­×¥¿?
©Ò¥H¤S¤W¨Ó½Ð±Ð
¥H¤W¥u¬O§Ú­Ó¤Hªº¤@ÂI·Qªk¡A¶È¨Ñ±z°Ñ¦Ò~BUGªº²q´ú¹ï©Î¤£¹ï¡A§Ú¨S¦³«H¤ß^^"

¯u¤£¦n·N«ä¡A¦]¬°·Q¬ã²ß¶Q»yªk¡A¤@¦Aµ¹±z²K³Â·Ð~©|½Ð±z¨£½Ì
VBAÁÙ¯u¤£©ö¾Ç¡A¥u¬O¤@­Ó¼Æ­È­Ó¼Æ²Î­pªº¤p°ÝÃD~´N¦Ò­Ë§Ú¤F

TOP

¦^´_ 26# ziv976688

­×§ïDATA¸Ìªº ¥Dµ{¦¡¡A±N¸ê®Æ½Æ»s»P®æ¦¡¤Æ§@·~¤ÀÂ÷¡A
­ì¥ý¸ê®Æ½Æ»s¤w¸g¬O§¹¾ã§@·~µ{§Ç¡A©ñ¦b®æ¦¡¤Æ§@·~¤º¦b¨C­Óªí®æ¤S­«½Æ°µ6¦¸
ÀɮװѦҦp¤U

    ¼Ð¥Ü©³¦â_ML089_C1_DATA_VBA­×§ï.zip (149.68 KB)
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 35# ziv976688
§Ú·Q±zªº"¼Ð¥Ü©³¦â"¤§µ{¦¡½XÀ³¸Ó¬O¥¿¸Ñ~
¦]¬°§Úµo²{Bug¥X¦b¦C12 xS.[a2] = xD.Count & "­Ó"¡A
¥¦·|Åý"·Ç6¶i7"ªºA2Åã¥Ü0­Ó¡A¦ý"·Ç7¶i8"ªºA2«oÅã¥Ü""¡A¥B¼Ð¥ÜÂÅ©³¦â¡F
¦pªG§Ú¦b¦C20´¡¤J xS.[a2] = Application.Count(xS.[A4:A52]) & "­Ó" ´ú¸Õ~
"·Ç7¶i8"ªºA2¤§ÂŦâ¼Ð¥Ü´N·|®ø¥¢¡C¦ýÁÙ¬OÅã¥Ü""(¤£¬OÅã¥Ü0­Ó)~
¥i¨£´¡¤J¦C20¤]¤£¬O§¹¥þ¥Í®Ä(¥¿½T)~¬O¤°»ò¦]?§Ú¤]¤£À´¡C
¦]¬°µ{¦¡ªº¬yµ{Ãö«Y¡A§Ú¬J¤£¯à²¾°£¦C12¡A¤]¤£ª¾¹D«ç»ò­×¥¿?


¾l¼Æ¦U¨ú1 ¦³ÂIBUG¡AxD.count=0®É¤£À³¸ÓEXIT FOR¡A¾É­P«á­±ªí®æ¨S¦³³B²z
Sub ¾l¼Æ¦U¨ú1()
    Dim xD As Object, xS As Worksheet, xR As Range, SP, N
    Tm = Timer
    Set xD = CreateObject("Scripting.Dictionary")
    For Each xS In Sheets(Split("·Ç2¶i3 ·Ç3¶i4 ·Ç4¶i5 ·Ç5¶i6 ·Ç6¶i7 ·Ç7¶i8"))    '¨úªí®æ
        For Each xR In xS.Range("D2:J" & xS.[B65536].End(xlUp).Row)    '¨úÀx¦s®æ
            For Each SP In Split(xR, ",")    '¤À¶}¼Æ¦r
                If Val(SP) > 0 Then xD(Val(SP)) = ""    '¦r¨å²Õ¦X
            Next
        Next
        N = xD.Count
        xS.[A2:A110].ClearContents    '²M°£Àx¦s®æ¤º®e
        xS.[A2] = IIf(N = 0, "", N & "­Ó")
        xS.[A3] = "¸¹½X"
        
        If N > 1 Then    'xD.Count > 1®É¡A¤~»Ý­n±Æ§Ç¡A¤£µM·|¿ù
            With xS.[A4].Resize(N)
                .Value = Application.Transpose(xD.keys)
                .Sort key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
            End With
        End If
        xD.RemoveAll
    Next
    Debug.Print Format(Timer - Tm, "0.00¬í") & " ¾l¼Æ¦U¨ú1"
End Sub

®æ¦¡¤Æ³¡¤À¯à»Ý­n¦b·L½Õ
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 37# ML089
xS.[A2] = IIf(N = 0, "", N & "­Ó")
µ{¦¡½X¨S¦³¿ù~
¬°¤°»ò"·Ç6¶i7"©M "·Ç7¶i8"ªºA2¤£¤@­P ?
¶i7ªºA2=0­Ó¡F¶i8ªºA2="" =>¤£¬OA2³£=""
½Ð½ç±Ð!ÁÂÁ±z

TOP

¥»©«³Ì«á¥Ñ ziv976688 ©ó 2021-7-27 17:54 ½s¿è

¦^´_ 37# ML089
ª©¥D:
¥þ³¡OK¤F~¶]§¹¤£¨ì2¬í~
ÁÂÁ±z±N¥þ³¡ªºµ{¦¡½X(§t©³¦â¼Ð¥Ü)­«·s¾ã²z~·P®¦

PS :38¼Óªº¦^ÂнФ£­n²z·|~§Ú¨S¦³±N36¼Óªº½d¨ÒÀÉ¡A¦A§ï¶K¤W37¼Óªº¶Q¸Ñ¡C
¦A¦¸·PÁ±z¦h¤é¨Óªº¼ö¤ßÀ°¦£©M­@¤ß«ü¾É~±z¨¯­W¤F

TOP

¦^´_  ML089
xS.[A2] = IIf(N = 0, "", N & "­Ó")
µ{¦¡½X¨S¦³¿ù~
¬°¤°»ò"·Ç6¶i7"©M "·Ç7¶i8"ªºA2¤£¤@­P ...
ziv976688 µoªí©ó 2021-7-27 16:35



  ¤§«eµ{¦¡¿ù»~¬O ¦]¬°«á­±¦³¦¹µ{§Ç EXIT FOR¡A
·í "·Ç6¶i7" [A2] = "" : EXIT FOR ´N¸õÂ÷FOR °j°é¡A"·Ç7¶i8"¨S¦³³Q°õ¦æ¨ì©Ò¥H¬O ªÅ®æ(¤@¯ëµø¬°0)
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

        ÀR«ä¦Û¦b : Ãø¦æ¯à¦æ¡AÃø±Ë¯à±Ë¡AÃø¬°¯à¬°¡A¤~¯àª@µØ¦Û§Úªº¤H®æ¡C
ªð¦^¦Cªí ¤W¤@¥DÃD