Sheet1中,有如下内容
A | B | W |
a1 | b1 | c1 |
a2 | b2 | |
a3 | b3 | |
b4 |
分别属于三个“定义”(插入 -- 名字 -- 定义)
Sheet2中,通过(数据 -- 输入规则 -- 设定 -- List)做出下拉框,内容为A,B,W
要实现,在Sheet2中,通过判断选择下拉框里的内容,来动态生成一个新下拉框,其内容为Sheet1中对应的内容。比如,选择A,那么要生成一个新的下拉框,内容为a1,a2,a3
代码如下:
Private
Sub
Worksheet_Change(ByVal Target
As
Range)
' 假定原有下拉框在第五列
If (Target.Column = 5 ) Then
' 如果选择了B,那么将第一列到第四列变颜色
If (Target.Text = " B " ) Then
Range(Cells(Target.Row, 1 ), Cells(Target.Row, 4 )).Select
' Range(Range("J2"), Range("J2").End(xlDown)).Select
' Range(Range("J2"), Range("J2").End(xlToRight)).Select
With Selection.Interior
.ColorIndex = 53
.Pattern = xlSolid
End With
End If
' 保存下拉框中所选择的值
Dim test As String
test = " = " & Target.Text
' 在原有下拉框的右侧单元格中生成新的下拉框
Cells(Target.Row, 6 ).Select
With Selection.Validation
.Delete
.Add Type: = xlValidateList, AlertStyle: = xlValidAlertStop, Operator: = _
xlBetween, Formula1: = test
.IgnoreBlank = True
.InCellDropdown = True
End With
Target.Activate
End If
End Sub
' 假定原有下拉框在第五列
If (Target.Column = 5 ) Then
' 如果选择了B,那么将第一列到第四列变颜色
If (Target.Text = " B " ) Then
Range(Cells(Target.Row, 1 ), Cells(Target.Row, 4 )).Select
' Range(Range("J2"), Range("J2").End(xlDown)).Select
' Range(Range("J2"), Range("J2").End(xlToRight)).Select
With Selection.Interior
.ColorIndex = 53
.Pattern = xlSolid
End With
End If
' 保存下拉框中所选择的值
Dim test As String
test = " = " & Target.Text
' 在原有下拉框的右侧单元格中生成新的下拉框
Cells(Target.Row, 6 ).Select
With Selection.Validation
.Delete
.Add Type: = xlValidateList, AlertStyle: = xlValidAlertStop, Operator: = _
xlBetween, Formula1: = test
.IgnoreBlank = True
.InCellDropdown = True
End With
Target.Activate
End If
End Sub