返回列表 上一主題 發帖

[發問] 不重覆列出

回復 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

TOP

回復 3# duck_simon

將程式碼貼到一般模組裡即可,謝謝

TOP

本帖最後由 samwang 於 2022-4-18 07:20 編輯

回復 6# duck_simon

參考Quake的做法小修改一下如附件,謝謝

不重覆列出_0418.zip (16.06 KB)

TOP

        靜思自在 : 修行要繫緣修心,藉事練心,隨處養心。
返回列表 上一主題