返回列表 上一主題 發帖

[發問] 不重覆列出

[發問] 不重覆列出

請教先進 :
重覆數字  列出
詳如附件內文說明..感謝指導..
不重覆列出.rar (7.56 KB)

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

回復 2# samwang

請問如何寫入?  小的笨拙..謝謝

TOP

回復 3# duck_simon

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

TOP

回復 1# duck_simon

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

TOP

回復 5# Quake
回復 2# samwang
回2位前輩..請幫我加入壓縮檔理好嗎?  我代入模組還是有問題...謝謝

TOP

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

回復 6# duck_simon

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

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

TOP

回復 7# samwang
回復 5# Quake
感謝二位大大的指導..成功可用..萬分感激..謝謝

TOP

隨意窩 "EXCEL迷"  blog  或https://blog.xuite.net/hcm19522/twblog
已收集8500篇 EXCEL函數

TOP

hcm19522 發表於 2022-4-19 12:17


感謝大大  仔細看了 很棒...:victory:

TOP

        靜思自在 : 天上最美是星星,人生最美是溫情。
返回列表 上一主題