.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=alist End With
Target.Offset(0, 1) = \
Target.Offset(0, 2) = \End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub
If Target.Column <> 8 And Target.Column <> 7 Then Exit Sub If Target.Row < 2 Then Exit Sub Dim aa$, bb$
If Target <> \
If Target.Column = 7 Then For i = 1 To UBound(Arr)
If Arr(i, 1) = Target.Value Then d(Arr(i, 2)) = \ End If Next i Else
Target.Offset(0, 1) = \ For i = 1 To UBound(Arr)
If Arr(i, 2) = Target.Value And Arr(i, 1) = Target.Offset(0, -1).Value Then d(Arr(i, 3)) = \ End If Next i End If k = d.keys
If d.Count > 1 Then
With Target.Offset(0, 1).Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, \ End With Else
Target.Offset(0, 1) = k(0) End If
d.RemoveAll End If End Sub
‘http://club.excelhome.net/thread-654547-2-1.html
有2列是合并单元格的情况
Public Myr&, d, Arr, d1, d2
Private Sub Worksheet_selectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column <> 12 Then Exit Sub If Target.Row < 2 Then Exit Sub Dim i&
Myr = Sheet17.Cells(Rows.Count, 4).End(xlUp).Row Arr = Sheet17.Range(\
Set d = CreateObject(\For i = 2 To UBound(Arr)
If Arr(i, 2) <> \Next
With Target.Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, \ End With
Target.Offset(0, 1).Resize(1, 2) = \End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target = \If Target.Row < 2 Then Exit Sub Dim n, n1, m&, j&
Set d1 = CreateObject(\Set d2 = CreateObject(\
If Target.Column = 12 Then For i = 2 To UBound(Arr)
If Arr(i, 2) <> \ Next
n = d(Target.Value)
If Sheet17.Cells(n, 2).MergeCells Then
m = Sheet17.Cells(n, 2).MergeArea.Count For j = n To n + m - 1
If Arr(j, 3) <> \ Next Else
d1(Arr(n, 3)) = n
End If
If d1.Count > 1 Then
With Target.Offset(0, 1).Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d1.keys, \ End With End If
ElseIf Target.Column = 13 Then Target.Offset(0, 1) = \
n = d(Target.Offset(0, -1).Value)
If Sheet17.Cells(n, 2).MergeCells Then
m = Sheet17.Cells(n, 2).MergeArea.Count For j = n To n + m - 1
If Arr(j, 3) <> \ Next Else
d1(Arr(n, 3)) =n End If
n1 = d1(Target.Value)
If Sheet17.Cells(n1, 3).MergeCells Then
m = Sheet17.Cells(n1, 3).MergeArea.Count For j = n1 To n1 + m - 1
If Arr(j, 4) <> \ Next Else
Target.Offset(0, 1).Validation.Delete Target.Offset(0, 1) = Arr(n1, 4): Exit Sub End If
If d2.Count > 1 Then
With Target.Offset(0, 1).Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d2.keys, \ End With End If End If End Sub ‘前
2列有合并单元格的情况
‘2014-8-7
‘http://club.excelhome.net/thread-1143611-1-1.html Public Myr&, d, Arr, d1, t
Private Sub Worksheet_selectionChange(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target.Column <> 8 Then Exit Sub If Target.Row < 4 Then Exit Sub Dim i&
Myr = Sheet6.Cells(Rows.Count, 4).End(xlUp).Row
Arr = Sheet6.Range(\ '下拉菜单范围 Set d1 = CreateObject(\Call yy t = d.items
With Target.Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d.keys, \ End With
Target.Offset(0, 1).Resize(1, 2) = \End Sub
Private Sub Worksheet_Change(ByVal Target As Range) If Target.Count > 1 Then Exit Sub If Target = \If Target.Row < 4 Then Exit Sub Dim n, n1, m&, j&
Set d2 = CreateObject(\ If Target.Column = 8 Then n = d(Target.Value)
If Sheet6.Cells(n, 2).MergeCells Then
m = Sheet6.Cells(n, 2).MergeArea.Count For j = n To n + m - 1
If Arr(j, 2) <> \ Next
k = d1.keys Else
d1(Arr(n, 1)) = Arr(n, 2) End If
If d1.Count > 1 Then
With Target.Offset(0, 1).Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(k, \ End With Else
Target.Offset(0, 1).Validation.Delete If m = 0 Then
Target.Offset(0, 1) = d1(Target.Value) Else
Target.Offset(0, 1) = k(0) End If End If
Target.Offset(0, 1).Select ElseIf Target.Column = 9 Then Call yy: d1.RemoveAll Target.Offset(0, 1) = \ Target.Offset(0, 1).Select
n = d(Target.Offset(0, -1).Value)
If Sheet6.Cells(n, 2).MergeCells Then
m = Sheet6.Cells(n, 2).MergeArea.Count For j = n To n + m - 1
If Arr(j, 2) <> \ Next Else
d1(Arr(n, 2)) = n & \ End If
n1 = d1(Target.Value) n1 = Left(n1, Len(n1) - 1) If InStr(n1, \ n1 = Val(n1)
If Sheet6.Cells(n1, 3).MergeCells Then
m = Sheet6.Cells(n1, 3).MergeArea.Count For j = n1 To n1 + m - 1
If Arr(j, 3) <> \ Next Else
Target.Offset(0, 1).Validation.Delete Target.Offset(0, 1) = Arr(n1, 3): Exit Sub End If Else
aa = Split(n1, \
For j = 0 To UBound(aa) d2(Arr(aa(j), 3)) = \ Next End If
If d2.Count > 1 Then
With Target.Offset(0, 1).Validation .Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _ Operator:=xlBetween, Formula1:=Join(d2.keys, \ End With