麻辣家族討論版版 - Powered by Discuz! Board

標題: 抓取篩選條件的值匯入listbox [打印本頁]

作者: wang077 時間: 2021-7-7 16:20 標題: 抓取篩選條件的值匯入listbox

[attach]33529[/attach]
請問我如何將每個欄位的篩選條件放進ListBox來篩選
[attach]33530[/attach]

作者: s3526369 時間: 2021-7-7 16:44

本帖最後由 s3526369 於 2021-7-7 16:46 編輯

回復 1# wang077

Set D = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
.Activate
For Each a In .Range(.[a2], .[a2].End(xlDown))
D(a.Value) = ""
Next
End With
ComboBox1.List = D.keys

複製代碼

我這個是用下式選單
你可以寄檔案給我幫你看
[email protected]

作者: wang077 時間: 2021-7-7 17:27

回復 2# s3526369
感謝幫忙，有辦法讓它從小到大排序嗎

作者: s3526369 時間: 2021-7-8 08:18

本帖最後由 s3526369 於 2021-7-8 08:20 編輯

回復 3# wang077

Dim crr
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
.Activate
For Each a In .Range(.[a2], .[a2].End(xlDown))
D(a.Value) = ""
Next
End With
crr = D.keys
'================================================================排序
For i = 0 To UBound(crr) - 1
k = i
For j = i + 1 To UBound(crr)
If crr(k) > crr(j) Then k = j '升序排列用">"，降序排列用"<"
Next
If k > i Then
X = crr(i)
crr(i) = crr(k)
crr(k) = X
End If
Next
ComboBox1.List = crr

複製代碼

作者: wang077 時間: 2021-7-8 08:49

回復 4# s3526369
感謝大大，解決我的疑惑

作者: s3526369 時間: 2021-7-8 08:59

回復 5# wang077
不用客氣有什麼問題可以再問

作者: wang077 時間: 2021-7-8 09:36

回復 6# s3526369
[attach]33532[/attach]
如果像這樣，F那欄空白幾格後，下面的抓不到了
範例檔案已寄到你的mail

作者: s3526369 時間: 2021-7-9 08:16

本帖最後由 s3526369 於 2021-7-9 08:17 編輯

回復 7# wang077 Dim crr
Dim i As Long
Set D = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
      .Activate
For Each a In .Range("A2", .[a2].End(xlDown))  '把[a2]改成[a1000]或者是[a2000] 格數可以自行設定
D(a.Value) = ""
Next
End With
crr = D.keys
'================================================================排序
For i = 0 To UBound(crr) - 1
   k = i
   For j = i + 1 To UBound(crr)
         If crr(k) > crr(j) Then k = j '升序排列用">"，降序排列用"<"
   Next
   If k > i Then
      X = crr(i)
      crr(i) = crr(k)
      crr(k) = X
   End If
Next

ComboBox1.List = crr

作者: wang077 時間: 2021-7-9 08:32

回復 8# s3526369
有了，感謝大神幫助
另外我想請教一下
如果我要抓取的格式是日期
如果按照這樣抓，好像抓不到格式耶

作者: wang077 時間: 2021-7-9 08:38

本帖最後由 wang077 於 2021-7-9 08:40 編輯

回復 8# s3526369
大大，剛剛看了一下
它好像會抓到重複值耶
[attach]33541[/attach]

作者: s3526369 時間: 2021-7-9 08:57

本帖最後由 s3526369 於 2021-7-9 08:58 編輯

回復 9# wang077
回復 10# wang077
For Each a In .Range("A2", .[a2].End(xlDown)) 'End(xlDown)要改成End(xlUp)

作者: wang077 時間: 2021-7-9 09:35

回復 11# s3526369
[attach]33545[/attach]
[attach]33546[/attach]
還是一樣耶

作者: s3526369 時間: 2021-7-9 10:59

回復 12# wang077

Dim crr
Dim i As Long
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
For Each A In .Range("F2", .[f5000].End(xlUp))
d(CDbl(A.Value)) = A.Value
Next
For i = 1 To d.Count
ComboBox1.AddItem d(Application.Small(d.keys, i)) '排序
Next

複製代碼

你改用這個試看看

作者: wang077 時間: 2021-7-9 11:21

回復 13# s3526369
一樣不行，直接中斷程式

作者: s3526369 時間: 2021-7-9 12:34

回復 14# wang077
你寄修改檔案給我幫你看

作者: s3526369 時間: 2021-7-9 12:39

回復 14# wang077

Private Sub CommandButton2_Click()
Dim crr
Dim i As Long
Set d = CreateObject("Scripting.Dictionary")
With Sheets("Sheet1")
For Each A In .Range("F2", .[f5000].End(xlUp))
d(CDbl(A.Value)) = A.Value
Next
For i = 1 To d.Count
ComboBox1.AddItem d(Application.Small(d.keys, i)) '排序
Next
End With
End Sub

複製代碼

[attach]33548[/attach]
[attach]33549[/attach]

作者: wang077 時間: 2021-7-9 13:53

回復 16# s3526369
解決了，剛剛不小心重複給combobox=crr了
謝謝大大

作者: wang077 時間: 2021-7-9 14:06

回復 16# s3526369
大大，如果有其他欄位也要抓取呢
是不是只要把d改掉?
因為我把d改掉，他卻抓不到型態

作者: s3526369 時間: 2021-7-9 14:50

回復 18# wang077
其他欄抓取就是改
這目前是F欄 For Each A In .Range("F2", .[f5000].End(xlUp))
改成A欄的話就把紅色部分改成A For Each A In .Range("A2", .[a5000].End(xlUp))

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)