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

2024-04-30 03:59

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
就行了。