返回列表 上一主題 發帖

[發問] 下拉VBA無法作動

[發問] 下拉VBA無法作動

請教各位先進,工作表上的2層下拉(函數),基本上是OK的,但因為增加了新增一個 ComboBox和VBA程式後,2層下拉卻無法使用,本來增加VBA的功能是把下拉的驗證視窗變大,現在卻無法使用,如果僅使用例外單層下拉驗證(如把程式放在"正常的"工作表上),VBA的功能卻可用,請各位先進解惑,謝謝!
附檔: 20181228.rar (17.53 KB)

本帖最後由 GBKEE 於 2018-12-30 07:40 編輯

回復 1# man65boy
驗證視窗無法變大
修改你的VBA  試試看
  1. Option Explicit
  2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  3.     With ComboBox1
  4.         '**Target > 事件所傳回的位置
  5.         If Not Intersect(Target, [a2:b2]) Is Nothing Then
  6.             Ex_ComboBox_list Target.Address(0, 0) '**呼叫程式 . 傳送參數
  7.             .Left = Target.Left
  8.             .Top = Target.Top
  9.             .Width = Target.Width + 15
  10.             .Height = Target.Height + 3
  11.             .LinkedCell = Target.Address
  12.             '改用 List ****
  13.             '.ListFillRange = StrVdFml
  14.             '***************
  15.             .Visible = 1
  16.             .Object.SpecialEffect = 3
  17.             .Object.Font.Size = Target.Font.Size
  18.         Else
  19.             .Visible = False
  20.         End If
  21.     End With
  22. End Sub
  23. Private Sub Ex_ComboBox_list(Target As String) 'vu. 修改改用 List
  24.     Dim Ar(), i As Variant  'Sheet2
  25.     With Sheets("Sheet2").Range("A1")   '**第一層的欄位向右的資料
  26.         Ar = Application.Transpose(Application.Transpose(Sheets("Sheet2").Range(.Cells, .Cells.End(xlToRight)).Value))
  27.     End With
  28.     Select Case Target
  29.         Case "A2"
  30.             ComboBox1.List = Ar
  31.         Case "B2"
  32.             i = Application.Match(Range("a2"), Ar, 0) '第一層的選擇** Match 傳回第二層的欄位
  33.             If IsError(i) Then  ' '***** 防呆******
  34.                 MsgBox IIf(Range("a2") = "", "A2 沒輸 入... ", Range("a2")) & vbLf & "--不在-- .." & vbLf & Join(Ar, ",")
  35.                 ComboBox1.Clear
  36.             Else
  37.                 With Sheets("Sheet2").Cells(2, i) '第二層的欄位的第二列
  38.                     Ar = Sheets("Sheet2").Range(.Cells, .Cells.End(xlDown)).Value
  39.                 End With
  40.                 ComboBox1.List = Ar
  41.             End If
  42.        End Select
  43. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 2# GBKEE


    謝謝GBKEE老師的幫忙修正,測試已可用,請問一下GBKEE老師,如果使用3層的下拉,也是要修改是吧!

TOP

本帖最後由 GBKEE 於 2019-1-6 15:29 編輯

回復 3# man65boy

抱歉 讓你久等
試試看


Ex_三層選單.zip (26.81 KB)


下載後先存檔案再開檔試試看
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 4# GBKEE
謝謝GBKEE大大熱心地回答,祝你新年快樂,順心健康!

TOP

        靜思自在 : 【做人的開始】每一天都是故人的開始,每一個時刻都是自己的警惕。
返回列表 上一主題