[發問] 下拉VBA無法作動

man65boy

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

下載次數: 5

2018-12-28 14:47

GBKEE

回復 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

複製代碼

man65boy

回復 2# GBKEE


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

GBKEE

回復 3# man65boy

抱歉 讓你久等
試試看


Ex_三層選單.zip (26.81 KB)

下載次數: 6

2019-1-6 15:24

下載後先存檔案再開檔試試看

man65boy

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