请教：如果序列 改到F、G、H列代码怎样改呀！

伍月焱马兔

请教：如果序列选项（取消A、B、C列） 改到F、G、H列代码怎样改呀！

shenjianrong163

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Column <> 6 And Target.Column <> 7 And Target.Column <> 8 Then Exit Sub
   
4. Dim d, i&, Myr&, Arr
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. Myr = Sheet1.[a65536].End(xlUp).Row
   
7. Arr = Sheet1.Range("a2:c" & Myr)
   
8. If Target.Column = 6 Then
   
9.     Set d = CreateObject("Scripting.Dictionary")
   
10.     For i = 1 To UBound(Arr)
    
11.         d(Arr(i, 1)) = ""
    
12.     Next
    
13.     With Target.Validation
    
14.         .Delete
    
15.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
16.         Operator:=xlBetween, Formula1:=Join(d.keys, ",")
    
17.     End With
    
18.     Target.Offset(0, 1) = ""
    
19.     Target.Offset(0, 2) = ""
    
20.     Set d = Nothing
    
21. ElseIf Target.Column = 7 And Target.Offset(0, -1) <> "" Then
    
22.     Set d = CreateObject("Scripting.Dictionary")
    
23.     For i = 1 To UBound(Arr)
    
24.         If Arr(i, 1) = Target.Offset(0, -1).Text Then
    
25.             d(Arr(i, 2)) = ""
    
26.         End If
    
27.     Next i
    
28.     With Target.Validation
    
29.         .Delete
    
30.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
31.         Operator:=xlBetween, Formula1:=Join(d.keys, ",") 'aa
    
32.     End With
    
33.     Target.Offset(0, 1) = ""
    
34.     Set d = Nothing
    
35. ElseIf Target.Column = 8 And Target.Offset(0, -1) <> "" Then
    
36.     Set d = CreateObject("Scripting.Dictionary")
    
37.     bb = Cells(Target.Row, 6) & "|" & Cells(Target.Row, 7)
    
38.     For i = 1 To UBound(Arr)
    
39.         If Arr(i, 1) & "|" & Arr(i, 2) = bb Then
    
40.             d(Arr(i, 3)) = ""
    
41.         End If
    
42.     Next i
    
43.     With Target.Validation
    
44.         .Delete
    
45.         .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
    
46.         Operator:=xlBetween, Formula1:=Join(d.keys, ",")
    
47.     End With
    
48.     Set d = Nothing
    
49. End If
    
50. End Sub

复制代码

shenjianrong163

请参考附件：



07200723.rar (11.5 KB, 下载次数: 2)

2020-3-4 19:54 上传

点击文件名下载附件
1

伍月焱马兔

谢谢老师，是想要的，麻烦老师：如果第一行是标题头，不参与序列菜单选项（从第二行开始），代码怎样改呢！