Excel中两个二级联动VBA实现一级变更时二级自动清除?

2024-05-20 16:52

1. Excel中两个二级联动VBA实现一级变更时二级自动清除?

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.Intersect(Target, Columns("D:F")) Is Nothing Or Target.Count > 1 Then Exit Sub
Target.Offset(, 1) = ""
End Sub

Excel中两个二级联动VBA实现一级变更时二级自动清除?

2. Excel 如何用VBA实现表之间联动

你说的联动是怎么个形式?详细说一下吧。有附件最好。
工作表事件应该可以解决你说的。

3. 谁能帮我注释下这段数据有效性多行三级联动VBA代码?我不是很懂

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    '的添加 类型=xlValidateList,公式1=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    '的添加 类型=xlValidateList,公式1=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    '的添加 类型=xlValidateList,公式1=strTemp
End With    'With语句结束
Else    '另外
	Exit Sub    '退出子程序
End If    'If判断过程结束
End Sub    '子程序结束

谁能帮我注释下这段数据有效性多行三级联动VBA代码?我不是很懂

4. excel VBA 写二级联动菜单时出错 是怎么回事

这能叫VBA么。
这段代码,不过是把制作二级联动的过程,录制了一个宏而已。
你在开始添一句
on error resume next
就行了。
最新文章
热门文章
推荐阅读