返回列表下一主題上一主題發帖

[發問] 下拉VBA無法作動

man65boy

中學生 Rank: 2

帖子: 169
主題: 39
精華: 0
積分: 252
點名: 0
作業系統: XP
軟體版本: 2003
閱讀權限: 20
註冊時間: 2011-4-17
最後登錄: 2020-7-17

2012龍年全勤獎章 2011兔年全勤獎章

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2018-12-28 14:47 | 只看該作者

[發問] 下拉VBA無法作動

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

20181228.rar (17.53 KB)

樓主熱帖

GBKEE

超級版主 Rank: 8 Rank: 8

帖子: 5923
主題: 13
精華: 1
積分: 5986
點名: 0
作業系統: win10
軟體版本: Office 2010
閱讀權限: 150
性別: 男
來自: 台灣基隆
註冊時間: 2010-5-1
最後登錄: 2022-1-23

2017 雞年全勤獎章 2016猴年全勤獎章 2015羊年全勤獎章 2014馬年全勤獎章 2013蛇年全勤獎章 2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章 2011兔年全勤獎章

2^#

發表於 2018-12-29 15:00 | 只看該作者

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

回復 1# man65boy
驗證視窗無法變大
修改你的VBA 試試看

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
With ComboBox1
'**Target > 事件所傳回的位置
If Not Intersect(Target, [a2:b2]) Is Nothing Then
Ex_ComboBox_list Target.Address(0, 0) '**呼叫程式 . 傳送參數
.Left = Target.Left
.Top = Target.Top
.Width = Target.Width + 15
.Height = Target.Height + 3
.LinkedCell = Target.Address
'改用 List ****
'.ListFillRange = StrVdFml
'***************
.Visible = 1
.Object.SpecialEffect = 3
.Object.Font.Size = Target.Font.Size
Else
.Visible = False
End If
End With
End Sub
Private Sub Ex_ComboBox_list(Target As String) 'vu. 修改改用 List
Dim Ar(), i As Variant 'Sheet2
With Sheets("Sheet2").Range("A1") '**第一層的欄位向右的資料
Ar = Application.Transpose(Application.Transpose(Sheets("Sheet2").Range(.Cells, .Cells.End(xlToRight)).Value))
End With
Select Case Target
Case "A2"
ComboBox1.List = Ar
Case "B2"
i = Application.Match(Range("a2"), Ar, 0) '第一層的選擇** Match 傳回第二層的欄位
If IsError(i) Then ' '***** 防呆******
MsgBox IIf(Range("a2") = "", "A2 沒輸入... ", Range("a2")) & vbLf & "--不在-- .." & vbLf & Join(Ar, ",")
ComboBox1.Clear
Else
With Sheets("Sheet2").Cells(2, i) '第二層的欄位的第二列
Ar = Sheets("Sheet2").Range(.Cells, .Cells.End(xlDown)).Value
End With
ComboBox1.List = Ar
End If
End Select
End Sub