samwang

¦^´_ 11# ziv976688

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ

Private Sub CommandButton1_Click()
Dim Arr, xD, s%, Tm, a%, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
Tm = Timer
Application.ScreenUpdating = False '¦b­I´º¤U°õ¦æ
   For s = 1 To 6   '6­Ó¤u§@ªí
        Shrr = Array("·Ç2¶i3", "·Ç3¶i4", "·Ç4¶i5", "·Ç5¶i6", "·Ç6¶i7", "·Ç7¶i8")
        With Sheets(Shrr(s - 1))
            Arr = .Range("d1:j" & .[b65536].End(3).Row)
            For i = 2 To UBound(Arr)
                For j = 1 To UBound(Arr, 2)
                    If Arr(i, j) <> "" Then
                        If InStr(Arr(i, j), ",") Then
                            For w = 0 To UBound(Split(Arr(i, j), ","))
                            a = Split(Arr(i, j), ",")(w): xD(a) = ""
                            Next
                        Else
                            xD(Arr(i, j)) = ""
                        End If
                    End If
                Next
            Next
            If xD.Count > 0 Then
                For i = 1 To xD.Count: Arr(i, 1) = Application.Small(xD.keys, i): Next
                With .Range("a4").Resize(xD.Count, 1)
                    .NumberFormatLocal = "00": .Value = Arr
                End With
                .[a2] = xD.Count & "­Ó": Erase Arr: xD.RemoveAll
            End If
        End With
   Next
MsgBox Timer - Tm
End Sub