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

[µo°Ý] ¼Æ¦r¦U¨ú1

¼Æ¦r¤£¶W¹L2¦ì¼Æ¾ã¼Æ¶Ü?
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 1# ziv976688

A2 °}¦C¤½¦¡¡A¦p¤U
=LOOKUP(99,IF({1;0},{0,""},{1,1}*SMALL((FREQUENCY(--(0&TRIM(MID(SUBSTITUTE(B$2:B$33&","&C$2:C$33&","&D$2:D$33&","&E$2:E$33&","&F$2:F$33&",,,,,",",","         "),{0,1,2,3,4}*9+1,9))),ROW($1:$99)-1)=0)*999+(ROW($1:$100)-1),ROW(A2))))
¥H¤TÁä¤è¦¡¿é¤J¤½¦¡(SHIT+CTRL+ENTER)

¤½¦¡­­¨î
¼Æ¦r1~99
B:F¨C¤@¦C¦X¨Ö¤§¼Æ¦r¦ê¼Æ¤]¤£¯à¤Ó¦h(3~5­Ó)¡A¦]¬°¦r¦ê¤À¹j¥u´¡¤J9­ÓªÅ®æ¡A¤]¥i¼W¥[´¡¤JªÅ®æ¨Ó´£°ª¦r¦ê¼Æ¡C
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 11# ziv976688

¤£¬O«Ü·|¼gVBA¡A´ê¤@­Óµ¹§A°Ñ¦Ò

Private Sub CommandButton1_Click()
    Set xD = CreateObject("Scripting.Dictionary")
    Tm = Timer
    Application.ScreenUpdating = False    '¦b­I´º¤U°õ¦æ
    Shrr = Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8")
    For s = 1 To 6   '6­Ó¤u§@ªí
        With Sheets(Shrr(s - 1))
            xRows = .[b65536].End(3).Row '¸ê®Æ³Ì«á¤@¦æ¦ì¸m
            .range("A2:A" & xRows).ClearContents '²M°£¸ê®Æ
            Arr = .range("D1:J" & xRows) '¸ê®ÆÂà°}¦C¡AJOIN·|§Ö3­¿ 0.023 -> 0.0078
            xJoin = ""
            For Each x In Arr: xJoin = xJoin & IIf(x <> "", x & ",", ""): Next '¦X¨ÖD:J¦r¦ê
            For Each xS In Split(xJoin, ","): xD(xS) = "": Next    '²Õ¦r¨å
            If xD.Count > 0 Then
                .[A4].Resize(xD.Count, 1) = Application.Transpose(xD.keys)    '¦r¨å¨ú°ß¤@¡B¤ô¥­Âà««ª½¡B¶ñ¤JÀx¦s®æ
                .[A4].Resize(xD.Count, 1).Sort Key1:=.[A4], Order1:=xlAscending, Header:=xlNo    'Àx¦s®æ±Æ§Ç
                .[A2] = xD.Count & "­Ó": .[A3] = "¸¹½X"
                Erase Arr: xD.RemoveAll
            End If
        End With
    Next
    MsgBox Timer - Tm
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 18# ziv976688

­×¥¿µ{¦¡ 02 »P 2 ·|­«½Æ
Private Sub CommandButton1_Click()
    Dim s%, Tm
    Tm = Timer
    Set xD = CreateObject("Scripting.Dictionary")
    Tm = Timer
    Application.ScreenUpdating = False    '¦b­I´º¤U°õ¦æ
    Shrr = Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8")
    For s = 1 To 6   '6­Ó¤u§@ªí
        With Sheets(Shrr(s - 1))
            xRows = .[b65536].End(3).Row    '¸ê®Æ³Ì«á¤@¦æ¦ì¸m
            .Range("A2:A" & xRows).ClearContents    '²M°£¸ê®Æ
            arr = .Range("D2:J" & xRows)    '¸ê®ÆÂà°}¦C¡AJOIN·|§Ö3­¿ 0.023 -> 0.0078
            'xJoin = ""
            For Each x In arr: xJoin = xJoin & IIf(x <> "", x & ",", ""): Next    '¦X¨ÖD:J¦r¦ê
            For Each xS In Split(xJoin, ",")
                If Val(xS) > 0 Then xD(Val(xS)) = "" '²Õ¦r¨å
            Next
            If xD.Count > 0 Then
                .[A4].Resize(xD.Count, 1) = Application.Transpose(xD.keys)    '¦r¨å¨ú°ß¤@¡B¤ô¥­Âà««ª½¡B¶ñ¤JÀx¦s®æ
                .[A4].Resize(xD.Count, 1).Sort Key1:=.[A4], Order1:=xlAscending, Header:=xlNo    'Àx¦s®æ±Æ§Ç
                .[A2] = xD.Count & "­Ó": .[A3] = "¸¹½X"
                Erase arr: xD.RemoveAll
            End If
        End With
    Next
    '     Sheets(Shrr).Copy
    '    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\TEST_" & Nrange & "-" & Num & "´Á" & ".xls"
    '    ActiveWindow.Close
    'MsgBox Timer - Tm
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

15¼Ó¼g±o«Üºë²
¾Ç²ß­«¼g¦p¤U
Private Sub CommandButton1_Click()
    Set xD = CreateObject("Scripting.Dictionary")
    Tm = Timer
    Application.ScreenUpdating = False    '¦b­I´º¤U°õ¦æ
    For Each xS In Sheets(Array("·Ç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)) = s '¦r¨å²Õ¦X
            Next
        Next
        xS.[A4].Resize(99).ClearContents '²M°£Àx¦s®æ¤º®e
        xS.[a2] = xD.Count & "­Ó": xS.[A3] = "¸¹½X"
        If xD.Count = 0 Then Exit For
        With xS.[A4].Resize(xD.Count)
            .Value = Application.Transpose(xD.keys): xD.RemoveAll
            .Sort key1:=.Item(1), Order1:=xlAscending, Header:=xlNo
        End With
    Next
End Sub
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

¦^´_ 27# ziv976688

1_¦C6ªºsp¬O¤°»ò²[¸q?  special?
»Ý¤£»Ý­n³]¥ßÅܼÆ?
2_§Ú²{¦b³]¥ßªºÅܼƹ藍¹ï?°÷¤£°÷¥þ?

SP¬O¤@­ÓÅܼơA¦WºÙ¬°ÀH·N©w¡A·íªì¬O¥H Split ²¼g
¦nªºµ{¦¡À³¸Ó¬O­n©w¸qÅܼƤñ¸ûÄYÂÔ¡A¦]¬°VBA¤£±j­¢«Å§iÅܼơA¥[¤W§Ú¬O·~¾l¼g¤pµ{¦¡´N¨S²ßºD©w¸qÅܼơC

³o¤pµ{¦¡¦³4­ÓÅܼƥi¥H©w¸q¦p¤U   
Dim xD As Object, xS As Worksheet, xR As Range, SP
{...} ªí¥Ü»Ý­n¥Î CTRL+SHIFT+ENTER ¤TÁä¿é¤J¤½¦¡

TOP

        ÀR«ä¦Û¦b : «Ý¤H°h¤@¨B¡A·R¤H¼e¤@¤o¡A´N·|¬¡±o«Ü§Ö¼Ö¡C
ªð¦^¦Cªí ¤W¤@¥DÃD