怎么用vba做出excel 单元格三级可选下拉的问题？ 50
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'----------------------------------------------------------------------
Dim D1 As Object, K1
Dim i As Integer
Dim Rng As Range
Dim Str As String
'----------------------------------------------------------------------
'当前工作表&当前工作表数组
Dim St As Worksheet
Dim R As Integer
Dim Arr
'----------------------------------------------------------------------
Set St = Sheets("Sheet1")
If Target.Count > 1 Then Exit Sub
R = St.Range("A" & Rows.Count).End(xlUp).Row
Arr = St.Range("A2:F" & R)
'----------------------------------------------------------------------
'H列的数据有效性
Set Rng = ActiveCell
If Rng.Column = St.Range("H1").Column And Rng.Row > 1 Then
Rng.Offset(0, 1).Validation.Delete
Rng.Offset(0, 2).Validation.Delete
Set D1 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
D1(Arr(i, 1)) = ""
Next
K1 = D1.Keys
With Rng.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(K1, ",")
End With
'i列的数据有效性
ElseIf Rng.Column = St.Range("I1").Column And Rng.Row > 1 And Rng.Offset(0, -1) <> "" Then
Rng.Offset(0, 1).Validation.Delete
Set D1 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Rng.Offset(0, -1) = Arr(i, 1) Then
D1(Arr(i, 2)) = ""
End If
Next
K1 = D1.Keys
With Rng.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(K1, ",")
End With
'J列的数据有效性
ElseIf Rng.Column = St.Range("J1").Column And Rng.Row > 1 And Rng.Offset(0, -1) <> "" And Rng.Offset(0, -2) <> "" Then
Set D1 = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Arr)
If Rng.Offset(0, -2) & Rng.Offset(0, -1) = Arr(i, 1) & Arr(i, 2) Then
D1(Arr(i, 3)) = ""
End If
Next
K1 = D1.Keys
With Rng.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(K1, ",")
End With
ElseIf Rng.Column = St.Range("K1").Column Then
If Rng.Row > 1 And Rng.Offset(0, -1) <> "" And Rng.Offset(0, -2) <> "" And Rng.Offset(0, -3) <> "" Then
Str = Rng.Offset(0, -3) & Rng.Offset(0, -2) & Rng.Offset(0, -1)
For i = 1 To UBound(Arr)
If Str = Arr(i, 1) & Arr(i, 2) & Arr(i, 3) Then
Rng = Arr(i, 4)
Rng.Offset(0, 1) = Arr(i, 5)
Rng.Offset(0, 2) = Arr(i, 6)
Exit For
End If
Next
End If
End If
Set D1 = Nothing
End Sub
