Board logo

標題: [發問] 請問：多個下拉式選單設計 [打印本頁]
作者: gaishutsusuru    時間: 2020-10-30 22:36     標題: 請問：多個下拉式選單設計

各位大大您好，
想請教以下的問題：

[attach]32662[/attach]
圖片與希望呈現說明：
(1) 欄A~欄D：是資料庫的概念。目前只先列出12筆資料。
(2) 欄I~欄L：是下拉式選單的設計。
(2-1) 欄I(主要分類)：希望呈現出不重複的清單：文具、生活、電器
(2-2) 欄J(項目)：希望呈現出不重複的清單
例2-2-1： 若欄I選文具時，欄J呈現出不重複的清單：A4紙(雖然資料庫有5個，但只需顯示1個)、直尺
例2-2-2： 若欄I選電器時，欄J呈現出不重複的清單：燈泡(雖然資料庫有2個，但只需顯示1個)
(2-3) 欄K(規格)：希望呈現出不重複的清單
例2-3-1：承例2-2-1，欄J選了A4紙，欄K呈現出不重複的清單：白色(雖然資料庫有2個，但只需顯示1個)
(2-4) 欄L(單位)：依欄K選擇的列出對應的清單
例：承例2-3-1，欄K選了白色，欄L呈現出清單：1箱、1包

附上檔案：[attach]32663[/attach]

再麻煩各位大大，抽空協助提供想法，謝謝您。
作者: ikboy    時間: 2020-10-31 10:35

  1. Dim d As Object
複製代碼
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2. Dim rng As Range, s$, k, t, xd As Object, i&, j&
  3. If Target.Cells.Count > 1 Then Exit Sub
  4. Set rng = [i2:l2]
  5. If Application.Intersect(rng, Target) Is Nothing Then Exit Sub
  6. If Target = rng(rng.Cells.Count) Then Exit Sub
  7. If d Is Nothing Then Call zz: Exit Sub
  8. Set xd = CreateObject("scripting.dictionary")
  9. For j = 1 To rng.Cells.Count
  10.      s = s & rng(j).Value & "|"
  11.     If Target = rng(j) Then Exit For
  12. Next
  13. 1000
  14. k = Filter(d.keys, s)
  15. For Each t In k
  16.     xd(Split(t, "|")(j)) = ""
  17. Next
  18. t = Join(xd.keys, ",")
  19. If t = "" Then s = s & "|": j = j + 1: rng(j).Validation.Delete: GoTo 1000
  20. With rng(j + 1).Validation
  21.     .Delete
  22.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
  23.     xlBetween, Formula1:=t
  24. End With
  25. Application.EnableEvents = 0
  26. i = InStr(t, ",")
  27. Select Case i
  28.     Case 0: rng(j + 1) = t
  29.     Case 1: rng(j + 1) = Mid(t, 2)
  30.     Case Else: rng(j + 1) = ""
  31. End Select
  32. rng(j + 1).Select
  33. Application.EnableEvents = 1
  34. End Sub
複製代碼
  1. Sub zz()
  2. Set d = CreateObject("scripting.dictionary")
  3. Dim a, b(), s$, k
  4. a = [a1].CurrentRegion.Value
  5. ReDim b(UBound(a, 2) - 1)
  6. For i = 2 To UBound(a)
  7.     d(a(i, 1)) = ""
  8.     For j = 1 To UBound(a, 2)
  9.         b(j - 1) = a(i, j)
  10.     Next
  11.     d(Join(b, "|")) = ""
  12. Next
  13. s = Join(Filter(d.keys, "|", False), ",")
  14. With [i2].Validation
  15.     .Delete
  16.     .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
  17.     xlBetween, Formula1:=s
  18. End With
  19. Application.ScreenUpdating = 0
  20. Application.EnableEvents = 0
  21. [i2:l2] = ""
  22. Application.ScreenUpdating = 1
  23. Application.EnableEvents = 1
  24. MsgBox "Please select item form " & [i1].Value & " first"
  25. [i2].Select
  26. End Sub
複製代碼
作者: gaishutsusuru    時間: 2020-10-31 11:08

回復 2# ikboy


謝謝 ，ikboy的協助，我再試看看
作者: gaishutsusuru    時間: 2020-10-31 11:08

回復 1# gaishutsusuru


想請問有可以不需要巨集的寫法嗎？謝謝
作者: jeffrey628litw    時間: 2020-11-22 17:48

本帖最後由 jeffrey628litw 於 2020-11-22 17:49 編輯

回復 4# gaishutsusuru


        大大您好：您如果是要做4層下拉選單，您要用您的方法，我所知道的是   最麻煩的製作方式 (PS：這種作業速度資料量一變大會電腦速度變很慢，
                             比 VBA 的 下拉選單 Listbox 慢非常多)：
                            附上教學檔給你參考，您可以自行研究看看。

檔案下載：  [attach]32700[/attach]
作者: jeffrey628litw    時間: 2020-11-22 17:59

回復 4# gaishutsusuru

          建議使用 VBA Listbox 下拉選單 (速度快，而且建立資料庫比較容易一點)：

[attach]32701[/attach]


   檔案下載：[attach]32702[/attach]



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