返回列表 上一主題 發帖

[發問] 利用下拉式選單選取資料,並進行進階篩選

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

回復 1# Duck

不重複定義是否B&D不重複?
play.gif
如果是的話
插入自訂表單,布置一個下拉清單
表單模組中程式碼如下
  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

  24. Private Sub UserForm_Initialize()
  25. Set d = CreateObject("Scripting.Dictionary")
  26. With 工作表1
  27.    For Each a In .Range(.[D2], .[D2].End(xlDown))
  28.       d(a.Text) = ""
  29.    Next
  30. End With
  31. ComboBox1.List = d.keys
  32. End Sub
複製代碼
上傳用.zip (28.34 KB)
學海無涯_不恥下問

TOP

回復 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
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 人生最大的成就是從失敗中站起來。
返回列表 上一主題