Board logo

標題: [發問] 利用下拉式選單選取資料，並進行進階篩選 [打印本頁]
作者: Duck    時間: 2014-7-24 18:32     標題: 利用下拉式選單選取資料，並進行進階篩選

各位大大們:

想請問一下，我想用工作表1的這些資料，利用"醫師代碼"這個欄位做出下拉式選單，
選出之後希望呈現狀態如工作表2一樣，並且B欄位與E欄位進行進階篩選(不重複)，選取在G與I欄位上，第J欄位是計算公式，這些作法如何用VBA呈現?

由於實際資料較為龐大，如用手動篩選工程浩大，故希望直接用VBA的語法去執行它，希望各位高手們幫忙!!! 感激不盡~~~
作者: Hsieh    時間: 2014-7-25 10:55

本帖最後由 Hsieh 於 2014-7-25 10:59 編輯

回復 1# Duck

不重複定義是否B&D不重複?
[attach]18758[/attach]
如果是的話
插入自訂表單，布置一個下拉清單
表單模組中程式碼如下
  1. Private Sub ComboBox1_Change()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With 工作表2
  4. Set Rng = 工作表2.[A1]
  5. .[A:E].Clear
  6. With 工作表1
  7.    With .Range("A1").CurrentRegion
  8.       .AutoFilter 4, ComboBox1
  9.       .SpecialCells(xlCellTypeVisible).Copy Rng
  10.       .AutoFilter
  11.    End With
  12. End With
  13. mystr = "=COUNTIF(C5,RC9)/(COUNTA(C7)-1)"
  14. For Each a In .Range(.[B2], .[B1].End(xlDown))
  15.     d(a & a.Offset(, 3)) = Array(a, "", a.Offset(, 3))
  16. Next
  17. .Range("G1").CurrentRegion.Offset(1).ClearContents
  18. .[G2].Resize(d.Count, 3) = Application.Transpose(Application.Transpose(d.items))
  19. .[J2].Resize(d.Count, 1).FormulaR1C1 = mystr
  20. .[H2] = d.Count
  21. End With
  22. Unload Me
  23. End Sub

  25. Private Sub UserForm_Initialize()
  26. Set d = CreateObject("Scripting.Dictionary")
  27. With 工作表1
  28.    For Each a In .Range(.[D2], .[D2].End(xlDown))
  29.       d(a.Text) = ""
  30.    Next
  31. End With
  32. ComboBox1.List = d.keys
  33. End Sub
複製代碼
[attach]18759[/attach]
作者: Duck    時間: 2014-7-25 23:43

感謝高手的襄助，但不好意思我沒把問題說清楚，我是希望第B欄位選取不重復至G欄位，第E欄位選取不重復至J欄位，是它們各自選取不重複，抱歉~ 語意沒說好....

另外，我想再請教一下，不知道語法是否可以執行說，我想先在A欄位選取不重複至L欄位，則M欄位可以去自動計算出，L欄位的每個一項目他們在B欄位不重複出現的次數是幾次?!

如下圖所示，我可以在L欄位裡的"19168"這個項目中計算出他分別有2013061011226和2013061011470這兩筆紀錄，故是在M欄位計算出現了2次，不知是否可以執行?



煩請高手能解救在下...感激不盡~~
作者: Duck    時間: 2014-7-27 22:34

回復 2# Hsieh

抱歉~由於忘記案回覆，故在重新發一篇~


感謝高手的襄助，但不好意思我沒把問題說清楚，我是希望第B欄位選取不重復至G欄位，第E欄位選取不重復至J欄位，是它們各自選取不重複，抱歉~ 語意沒說好....


另外，我想再請教一下，不知道語法是否可以執行說，我想先在A欄位選取不重複至L欄位，則M欄位可以去自動計算出，L欄位的每個一項目他們在B欄位不重複出現的次數是幾次?!

如下圖所示，我可以在L欄位裡的"19168"這個項目中計算出他分別有2013061011226和2013061011470這兩筆紀錄，故是在M欄位計算出現了2次，不知是否可以執行?



煩請高手能解救在下...感激不盡~~
作者: Duck    時間: 2014-7-28 19:29

回復 2# Hsieh


    Hsieh 您好:

不知我的問題是否描述有讓你不清楚的地方嗎? 哪個部分不瞭解，我可以再加以說明，希望你能幫幫我這個vba初學者~ 萬分感激 :)
作者: Duck    時間: 2014-7-30 20:08

回復 2# Hsieh


您好，這個程式跑出來工作表2的G欄位與I欄位還是"各自"還是會出現重複的情形，請問語法要如何修改，才會它們欄位是出現各自不重複的情況??


跪求大師幫忙~~~~:dizzy:
作者: Hsieh    時間: 2014-7-31 10:36

回復 6# Duck
  1. Private Sub ComboBox1_Change()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. Set d1 = CreateObject("Scripting.Dictionary")
  4. Set d2 = CreateObject("Scripting.Dictionary")
  5. Set d3 = CreateObject("Scripting.Dictionary")
  6. d2("CHT_IDX") = "B欄不重複數" 'L:M的欄位名稱"
  7. d3("CHT_IDX") = "B欄不重複數"
  8. With 工作表2
  9. Set Rng = 工作表2.[A1]
  10. .[A:E].ClearContents '清除之前篩選結果
  11. With 工作表1
  12.    With .Range("A1").CurrentRegion
  13.       .AutoFilter 4, ComboBox1 '依據下拉選單篩選資料
  14.       .SpecialCells(xlCellTypeVisible).Copy Rng '將篩選結果複製到第二工作表
  15.       .AutoFilter '取消篩選
  16.    End With
  17. End With
  18. mystr = "=COUNTIF(C5,RC9)/(COUNTA(C7)-1)" 'J欄公式
  19. For Each a In .Range(.[B2], .[B1].End(xlDown)) 'B欄資料做迴圈
  20.     d(a.Value) = "" '儲存DATESEQ不重複清單
  21.     d1(a.Offset(, 3).Value) = "" '儲存PRICE_NAME不重複清單
  22.     d3(a.Offset(, -1).Value) = _
  23.     IIf(InStr(d3(a.Offset(, -1).Value), a) = 0, d3(a.Offset(, -1).Value) & ";" & a, d3(a.Offset(, -1).Value)) '以A欄為索引，若未含B欄字串，則以分號;連結B欄字串
  24.     d2(a.Offset(, -1).Value) = UBound(Split(d3(a.Offset(, -1).Value), ";")) '以分號切割字串，計算出陣列元素數量，即為同CHT_IDX的不重複B欄數量
  25. Next
  26. .Range("G1").CurrentRegion.Offset(1).ClearContents
  27. .[L:M].ClearContents '清除L:M欄
  28. '寫入G:M欄
  29. .[G2].Resize(d.Count, 1) = Application.Transpose(d.Keys)
  30. .[I2].Resize(d1.Count, 1) = Application.Transpose(d1.Keys)
  31. .[L1].Resize(d3.Count, 1) = Application.Transpose(d3.Keys)
  32. .[M1].Resize(d2.Count, 1) = Application.Transpose(d2.items)
  33. .[J2].Resize(d1.Count, 1).FormulaR1C1 = mystr
  34. .[H2] = d.Count
  35. End With
  36. Unload Me '卸載表單
  37. End Sub
複製代碼
作者: Duck    時間: 2014-7-31 22:53

回復 7# Hsieh


    感謝高手的襄助! 可以成功執行了~~~ 謝謝!!!
作者: SWRovers    時間: 2014-12-12 08:54

thanks ,又學習到了
作者: lostshin5208    時間: 2015-3-17 10:32

謝謝版主，這份資料也讓我解決我的問題並且學到很多！！！！
作者: ChuckBucket    時間: 2019-4-12 14:38

回復 2# Hsieh

哈囉Hsieh大，
我在練習此帖的過程發現一些問題。
當中這段代碼想要請教您 :
  1. Private Sub UserForm_Initialize()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. With 工作表1
  4.    For Each a In .Range(.[D2], .[D2].End(xlDown))
  5.       d(a.Text) = ""
  6.    Next
  7. End With
  8. ComboBox1.List = d.keys
  9. End Sub
複製代碼
我懂這一段的用意是要將「要查詢的不重複項目」帶進下拉式選單的選項項目；
但是在 For Each a In .Range(.[D2], .[D2].End(xlDown))和Next中的d(a.Text) = ""
我不太了解為何要將所有項目的文字變成""，這段撰寫的緣由是來自何處？
還勞煩您幫忙解惑。
作者: 准提部林    時間: 2019-4-13 10:52

本帖最後由 准提部林 於 2019-4-13 10:54 編輯

回復 11# ChuckBucket

字典檔 >> 利用"KEY"值, 帶一個"ITEM"
d(a.Text) = ""
a.Text 是 KEY
"" 是 ITEM, 這ITEM可為任何型態資料

因只取不重覆, 只用得到KEY, 不做其它處理,
所以ITEM用""空字符即可(也可用其它字符或數字)
d(a.Text) = "A"
d(a.Text) = 1
都是可以達到目的, 不過在這個需求上,"A"或1都沒有意義
=============================
d(a.Text) = d(a.Text) + 1 這個就可以累計 a.Text 的次數
其它用途可多看幾個範例帖吧!!!
作者: ChuckBucket    時間: 2019-4-14 21:37

回復 12# 准提部林
Hi 准大，
感謝你的回覆。
所以Hsieh大在Private sub裏頭For each裏頭的寫法，d(a.text) = ""其實等同於d.add  a , ""嗎？
我能這樣理解嗎？
作者: 准提部林    時間: 2019-4-15 09:48

回復 13# ChuckBucket


是的~~



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