[發問] 不重覆列出

　暱稱: duck_simon

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

10^#

發表於 2022-4-26 11:37 | 只看該作者

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

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

hcm19522

https://blog.xuite.net/hcm19522/twblog/590346359

帖子: 1387
主題: 4
精華: 0
積分: 1397
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-11-25

熱烈參與勳章

9^#

發表於 2022-4-19 12:17 | 只看該作者

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

　暱稱: duck_simon

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

8^#

發表於 2022-4-18 19:34 | 只看該作者

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

samwang

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

7^#

發表於 2022-4-18 07:19 | 只看該作者

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

回復 6# duck_simon

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

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

　暱稱: duck_simon

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

6^#

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

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

Quake

帖子: 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

samwang

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

4^#

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

回復 3# duck_simon

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

　暱稱: duck_simon

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

3^#

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

回復 2# samwang

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

samwang

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

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