請測試看看，謝謝
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作者: duck_simon 時間: 2022-4-17 18:55
Sub Ex()
Dim d As Object
Dim cell As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cell In [B2:M3]
d(cell.Value) = ""
Next cell
Rows("6").ClearContents
[B6].Resize(1, d.Count) = d.keys
[B6].Resize(1, d.Count).Sort Key1:=[B6], Orientation:=xlLeftToRight
End Sub作者: duck_simon 時間: 2022-4-17 21:46
