麻辣家族討論版版 - Powered by Discuz! Board

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

複製代碼