Option Explicit '强制定义变量(如果有本句存于开始,则所有变量需定义)
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '当工作表选区发生改变时执行本程序(固定格式)
Dim i As Integer '定义变量 i 为 整型值
Dim lastRow As Long '定义变量 lastRow 为 长整型值
Dim strTemp As String '定义变量 strTemp 为 字符串
Dim rgs As Range '定义变量 rgs 为 单元格区域
Dim rg As Range '定义变量 rg 为 单元格区域
Dim d, Res '定义变量 d,Res
lastRow = Sheet2.Range("A65536").End(xlUp).Row ' lastRow= Sheet2的<单元格>区域("A65536" )的<末端>(方向向上 )的行标
On Error Resume Next '当错误 转到 下一个
If Target.Column = 1 Then '如果 Target的列标=1 则执行
Set rgs = Sheet2.Range("A2:A" & lastRow) '设定rgs= Sheet2的<单元格>区域("A2:A" & lastRow)
Set d = CreateObject("Scripting.Dictionary") '设定d=<创建工程>("Scripting.Dictionary")
For Each rg In rgs '设定变量范围为每一个rg位于rgs
If Not d.exists(rg.Value) Then '如果 非 d的存在 rg的值) 则执行
d.Add rg.Value, rg.Value ' d的添加 rg的值, rg的值
End If 'If判断过程结束
Next '下一个
Res = d.Items 'Res= d的Items
Dim arr1() '定义变量 arr1()
For i = 0 To d.Count - 1 '设定变量范围为 i=0到 d的计数值-1
ReDim Preserve arr1(i) '重定义变量预留的arr1(i)
arr1(i) = Res(i) 'arr1(i)=Res(i)
Next '下一个
strTemp = Join(arr1, ",") 'strTemp=<连接字符串>(arr1,",")
Erase arr1 '删除arr1
With Target.Validation '工作于 Target的Validation
.Delete '
.Add Type:=xlValidateList, Formula1:=strTemp '
End With 'With语句结束
ElseIf Target.Column = 2 Then '另外如果 Target的列标=2 则执行
Set rgs = Sheet2.Range("B2:B" & lastRow) '设定rgs= Sheet2的<单元格>区域("B2:B" & lastRow)
Set d = CreateObject("Scripting.Dictionary") '设定d=<创建工程>("Scripting.Dictionary")
For Each rg In rgs '设定变量范围为每一个rg位于rgs
If Not d.exists(rg.Value) Then '如果 非 d的存在 rg的值) 则执行
If rg.Offset(, -1) = Target.Offset(, -1) Then '如果 rg的<偏移>(,-1)= Target的<偏移>(,-1) 则执行
d.Add rg.Value, rg.Value ' d的添加 rg的值, rg的值
End If 'If判断过程结束
End If 'If判断过程结束
Next '下一个
Res = d.Items 'Res= d的Items
Dim arr2() '定义变量 arr2()
For i = 0 To d.Count - 1 '设定变量范围为 i=0到 d的计数值-1
ReDim Preserve arr2(i) '重定义变量预留的arr2(i)
arr2(i) = Res(i) 'arr2(i)=Res(i)
Next '下一个
strTemp = Join(arr2, ",") 'strTemp=<连接字符串>(arr2,",")
Erase arr2 '删除arr2
With Target.Validation '工作于 Target的Validation
.Delete '
.Add Type:=xlValidateList, Formula1:=strTemp '
End With 'With语句结束
ElseIf Target.Column = 3 Then '另外如果 Target的列标=3 则执行
Set rgs = Sheet2.Range("C2:C" & lastRow) '设定rgs= Sheet2的<单元格>区域("C2:C" & lastRow)
Set d = CreateObject("Scripting.Dictionary") '设定d=<创建工程>("Scripting.Dictionary")
For Each rg In rgs '设定变量范围为每一个rg位于rgs
If Not d.exists(rg.Value) Then '如果 非 d的存在 rg的值) 则执行
If rg.Offset(, -2) = Target.Offset(, -2) Then '如果 rg的<偏移>(,-2)= Target的<偏移>(,-2) 则执行
If rg.Offset(, -1) = Target.Offset(, -1) Then '如果 rg的<偏移>(,-1)= Target的<偏移>(,-1) 则执行
d.Add rg.Value, rg.Value ' d的添加 rg的值, rg的值
End If 'If判断过程结束
End If 'If判断过程结束
End If 'If判断过程结束
Next '下一个
Res = d.Items 'Res= d的Items
Dim arr3() '定义变量 arr3()
For i = 0 To d.Count - 1 '设定变量范围为 i=0到 d的计数值-1
ReDim Preserve arr3(i) '重定义变量预留的arr3(i)
arr3(i) = Res(i) 'arr3(i)=Res(i)
Next '下一个
strTemp = Join(arr3, ",") 'strTemp=<连接字符串>(arr3,",")
Erase arr3 '删除arr3
With Target.Validation '工作于 Target的Validation
.Delete '
.Add Type:=xlValidateList, Formula1:=strTemp '
End With 'With语句结束
Else '另外
Exit Sub '退出子程序
End If 'If判断过程结束
End Sub '子程序结束