[發問] 不重覆列出

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

不重覆列出.rar (7.56 KB)

樓主熱帖

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-12-18

2^#

發表於 2022-4-17 15:09 | 只看該作者

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

duck_simon

　暱稱: duck_simon

中學生 Rank: 2

帖子: 120
主題: 34
精華: 0
積分: 174
點名: 0
作業系統: win10
軟體版本: Office 2016
閱讀權限: 20
性別: 男
來自: 台中
註冊時間: 2010-5-4
最後登錄: 2024-11-20

3^#

發表於 2022-4-17 18:55 | 只看該作者

回復 2# samwang

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

TOP

samwang

大學生 Rank: 4

帖子: 976
主題: 7
精華: 0
積分: 1018
點名: 0
作業系統: Win10
軟體版本: Office 2016
閱讀權限: 50
性別: 男
註冊時間: 2013-4-19
最後登錄: 2024-12-18

4^#

發表於 2022-4-17 20:31 | 只看該作者

回復 3# duck_simon

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

TOP

Quake

中學生 Rank: 2

帖子: 6
主題: 1
精華: 0
積分: 57
點名: 0
作業系統: Win7
軟體版本: Office 2010
閱讀權限: 20
註冊時間: 2021-7-3
最後登錄: 2024-4-27

5^#

發表於 2022-4-17 21:09 | 只看該作者

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

duck_simon