- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2025-1-10
|
回復 1# duck_simon
請測試看看,謝謝
Sub test()
Dim Arr, xD, T$, i&, j%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range("b2:m3")
For i = 1 To UBound(Arr): For j = 1 To UBound(Arr, 2)
T = Arr(i, j): If T <> "" Then xD(T) = ""
Next: Next
Range("bb1").Resize(xD.Count, 1) = Application.Transpose(xD.keys)
With Range("bb1:bb" & xD.Count)
.Sort Key1:=.Item(1), Order1:=1, Header:=2
End With
Arr = Range("bb1:bb" & xD.Count)
Range("bb1:bb" & xD.Count).Clear
Range("b6").Resize(1, UBound(Arr)) = Application.Transpose(Arr)
End Sub |
|