- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2024-4-29
|
12#
發表於 2021-7-19 13:49
| 只看該作者
回復 11# ziv976688
請測試看看，謝謝
Private Sub CommandButton1_Click()
Dim Arr, xD, s%, Tm, a%, i&, j&
Set xD = CreateObject("Scripting.Dictionary")
Tm = Timer
Application.ScreenUpdating = False '在背景下執行
For s = 1 To 6 '6個工作表
Shrr = Array("準2進3", "準3進4", "準4進5", "準5進6", "準6進7", "準7進8")
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 |
|
!
)。
發表於 2021-7-10 12:04
| 
