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

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

¦^´_ 1# ziv976688
Sub ¾l¼Æµn¿ý()
    Dim xS As Worksheet, xV As Range, xD, SP
    Tm = Timer
    For Each xS In Sheets(Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8"))    '¨úªí®æ
        For Each xV In xS.Range("V2:AB" & xS.[B65536].End(xlUp).Row)    '¨úÀx¦s®æ
            xD = ""
            For Each SP In Split(xV, ",")    '¤ÀÂ÷¦r¦ê
                SP = (SP + xV.Offset(, -9)) Mod 49: If SP = 0 Then SP = 49 'V2+M2 mod 49
                xD = xD & "," & Format(SP, "00")
            Next
            xV.Offset(30, -18) = Mid(xD, 2, 99) '´ú¸Õ¥Î ¦ì¸m¤U²¾30®æ
            'xV.Offset(, -18) = Mid(xD, 2, 99) '¥¿½T¦ì¸m
        Next
    Next
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¥»©«³Ì«á¥Ñ ML089 ©ó 2021-7-25 17:25 ½s¿è

¦^´_ 9# ziv976688

Sub ¼Ð¥Ü©³¦â()
    Dim  xS As Worksheet, xR As Range, SP, r
   
    For Each xS In Sheets(Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8"))    '¨úªí®æ
        r = xS.[B65536].End(xlUp).Row
        For Each xR In xS.Range("A4:A" & xS.[A65536].End(xlUp).Row)    '¨úÀx¦s®æ
            'xR.Interior.ColorIndex = 0 '²M©³¦â
            If Not xS.Range("M2:S" & r).Find(xR) Is Nothing Then xR.Interior.ColorIndex = 8  '¼Ð¥ÜÂÅ©³¦â
        Next

        For Each xR In xS.Range("D2:J" & r - 1)    '¨úÀx¦s®æ
            'xR.Interior.ColorIndex = 0 '²M©³¦â
            For Each SP In Split(xR, ",")    '¤À¶}¼Æ¦r
                If Not xS.Range("M2:S" & r).Find(Val(SP)) Is Nothing Then xR.Interior.ColorIndex = 8: Exit For    '¼Ð¥ÜÂÅ©³¦â
            Next
        Next
    Next
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 11# ziv976688
¬O³Ì«á¤@¦C¸ê®Æ¡A§Ú¬Ý¿ù¤F¡A­×¥¿¦p¤U
Sub ¼Ð¥Ü©³¦â_ML089()
    Dim xD As Object, xS As Worksheet, xR As Range, SP, r
    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
        For Each xR In xS.Range("A4:A" & xS.[A65536].End(xlUp).Row)    '¨úÀx¦s®æ
            xR.Interior.ColorIndex = 0 '²M©³¦â
            'If xR > 0 And xR = xS.Range("M" & xS.[B65536].End(xlUp).Row, "S" & xS.[B65536].End(xlUp).Row) Then xR.Interior.ColorIndex = 8  '¼Ð¥ÜÂÅ©³¦â
            If Not xS.Range("M" & r, "S" & r).Find(xR, LookAt:=xlWhole) Is Nothing Then xR.Interior.ColorIndex = 8  '¼Ð¥ÜÂÅ©³¦â
        Next

        For Each xR In xS.Range("D2:J" & r - 1)    '¨úÀx¦s®æ
            xR.Interior.ColorIndex = 0 '²M©³¦â
            For Each SP In Split(xR, ",")    '¤À¶}¼Æ¦r
                'If Val(SP) > 0 And Val(SP) = xS.Range("M" & xS.[B65536].End(xlUp).Row, "S" & xS.[B65536].End(xlUp).Row) Then xD(Val(SP)).Interior.ColorIndex = 8 '¼Ð¥ÜÂÅ©³¦â
                If Not xS.Range("M" & r, "S" & r).Find(Val(SP), LookAt:=xlWhole) Is Nothing Then xR.Interior.ColorIndex = 8: Exit For     '¼Ð¥ÜÂÅ©³¦â
            Next
        Next
    Next
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 17# ziv976688

§Ú°õ¦æ¬OÁÙ¦n4.5¬í§¹¦¨¡A·íµM§ï¬°°}¦C

·Ç7¶i8 ªº V2:AB2 ¸ê®Æ¦³»~¡A§A­×§ï«á¦b°õ¦æ¬Ý¬Ý
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 17# ziv976688

°ÝÃD1¡GDATA!VB ¤U¦C©ñ¸m¦ì¸mÀ³¸Ó¦b °j°é¤§¥~
    For s = 1 To 6   '6­Ó¤u§@ªí
        Shrr = Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8")
.
.
    NEXT
            'Call °Ñ¼Æµn¿ý
            Call ¾l¼Æµn¿ý
            Call ¾l¼Æ¦U¨ú1
            Call ¼Ð¥Ü©³¦â

    °ÝÃD2¡G "·Ç7¶i8" °µ¥X¨Óªº¸ê®Æ¦³»~¡A§A¦A¬d¬Ý¬Ý
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 26# ziv976688

ª©­±ªº³]©w¡AÀ³¸Ó¬O©ñ¨ì³Ì«á­±¡A¶¶§Ç¦p¤U

¸ê®Æ
­pºâ
±Æª©
¦C¦L
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

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

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

¦^´_  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 : ¡i»X½ªªº¦Û¥Ñ¡j¤H±`¦b¤°»ò³£¥i¥H¦Û¥Ñ¦Û¦bªº®É­Ô¡A«o³Q³oºØÀH¤ß©Ò±ýªº¦Û¥Ñ»X½ª¡AµêÂY®É¥ú¦Ó²@µLıª¾¡C
ªð¦^¦Cªí ¤W¤@¥DÃD