VBA多级联动更新代码

Option Explicit

Sub updateList()
    Application.ScreenUpdating = False '取消屏幕闪烁
    Dim i As Integer '循环index
    Dim j As Integer '横向index
    Dim k As Integer '输出index
    k = 2 '设置辅助表行数初始值
    For i = 1 To ThisWorkbook.Names.Count
        ThisWorkbook.Names(1).Delete '循环删除名称管理器中内容
    Next
    With Sheet1
        '第一部分
        .Range("L:IV").ClearContents '删除L列到最后一列的内容
        For i = 2 To .Range("I" & 2 ^ 16).End(xlUp).Row '从第2行开始直到【工序】列最后一位不为空的值所在行
            If .Range("G" & i).Value <> "" Then '如果【名称】列当前值不为空
                j = 13 '则使列初始值为13,也就是L列
                .Range("L" & k).Value = .Range("G" & i).Value 'L列输入G列内容即——"名称"
                If i > 2 Then '当获取行数大于2时,也就是从基础数据表第3行开始获取时
                    .Cells(k, j).Value = .Range("H" & i).Value '横向填充【图号】列内容。同时满足【名称】列当前行不为空的条件
                    .Cells(2, .Range("IV2").End(xlToLeft).Column + 1).Value = .Range("G" & i).Value '横向填充【名称】列内容
                End If
                k = k + 1 '执行完后,行数值+1
            ElseIf .Range("H" & i).Value <> "" Then '否则如果【图号】列当前行不为空时,此时为避免该列中存在多个合并单元格的情况出现
                j = j + 1 '列号+1,也就是往右平移一个位置
                If i > 2 Then .Cells(k - 1, j).Value = .Range("H" & i).Value '横向填充【图号】列内容
            End If
        Next
        '第二部分
        For i = 3 To .Range("I" & 2 ^ 16).End(xlUp).Row '从第3行开始直到【工序】列最后一位不为空的值所在行
            If .Range("H" & i).Value <> "" Then '如果【图号】列当前值不为空
                j = 13 '则使列初始值为13,也就是L列
                .Range("L" & k).Value = .Range("H" & i).Value '纵向填充【图号】列内容,初始行数值k由上述循环结果决定,接下来的k值由本次循环结果决定
                .Cells(k, j).Value = .Range("I" & i).Value '横向填充【工序】列内容
                k = k + 1
            Else
                j = j + 1 '否则,列号+1,也就是往右平移一个位置
                .Cells(k - 1, j).Value = .Range("I" & i).Value '横向填充【工序】列内容
            End If
        Next
        '定义名称
        .Range("L:IV").SpecialCells(xlCellTypeConstants, 23).CreateNames False, True, False, False '创建名称
    End With
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    updateList
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    '更新列表
    If Target.Column = 2 And Target.Row > 2 Then
        ActiveCell.Offset(0, 1).Value = ""
        ActiveCell.Offset(0, 2).Value = ""
    ElseIf Target.Column = 3 And Target.Row > 2 Then
        ActiveCell.Offset(0, 1).Value = ""
    End If
    '更新辅助表
    If Target.Column > 6 And Target.Column < 11 And Target.Row > 1 Then
        updateList
    End If
End Sub

  • 0
    点赞
  • 4
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
Excel 三级 联 下拉框 宏代码 实例 代码注释 先在第一个下拉框加入一个valiation, 内容是 =$A$2:$A$5 Private Sub Worksheet_Change(ByVal Target As Range) ' Call back function which defined within according worksheet Dim i As Integer Dim tempStr As String Dim firstDrawBoxRowCount As Integer Dim firstDrawBoxColumn As Integer firstDrawBoxRowCount = 4 'Define the row number of first draw box firstDrawBoxColumn = 1 'Define the column number of ifrst draw box Dim secondDrawBoxRowCount As Integer Dim secondDrawBoxColumn As Integer secondDrawBoxRowCount = 33 'Define the row number of second draw box secondDrawBoxColumn = 4 'Define the column number of second draw box If Target.Column = 1 Then 'This defines the first column of draw box list, you can also define the row number of draw box list Cells(Target.Row, Target.Column + 1) = "" ' Do the clean first Cells(Target.Row, Target.Column + 1).Validation.Delete Cells(Target.Row, Target.Column + 2) = "" Cells(Target.Row, Target.Column + 2).Validation.Delete For i = 2 To firstDrawBoxRowCount + 1 'Enter the cycle to find out the content for column 2 If Trim(Cells(Target.Row, Target.Column)) = Trim(Cells(i, firstDrawBoxColumn)) Then tempStr = Trim(Cells(i, firstDrawBoxColumn + 1)) 'Find out the options for second draw box, it is seperated by , Cells(Target.Row, Target.Column + 1).Select ' Fill the validation to second draw box With Selection.Validation .Delete .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _ xlBetween, Formula1:=tempStr .IgnoreBlank = True .InCellDropdown = True .InputTitle = "" .ErrorTitle = "" .InputMessage = "" .ErrorMessage = "" .IMEMode = xlIMEModeNoControl .ShowInput = True .ShowError = True
多级菜单录入是一种在VBA中创建具有分级结构的菜单的方法。这种方法可以帮助用户以更直观和方便的方式进行操作和选择。 要创建多级菜单,我们需要使用VBA的UserForm和MenuStrip控件。首先,在UserForm中添加一个MenuStrip控件,然后在MenuStrip控件上添加菜单项和子菜单项。 在VBA中,我们可以使用AddItem方法来添加菜单项和子菜单项。例如,我们可以使用以下代码向菜单添加一个菜单项: MenuStrip1.AddItem "菜单项1" 要添加子菜单项,我们可以使用AddItem方法的第二个参数来指定它们属于的菜单项。例如,以下代码向菜单项1添加一个子菜单项: MenuStrip1.AddItem "子菜单项1", 1 通过重复这个过程,我们可以为每个菜单项添加子菜单项,从而创建多级菜单。例如,以下代码添加了一个菜单项及其两个子菜单项: MenuStrip1.AddItem "菜单项1" MenuStrip1.AddItem "子菜单项1", 1 MenuStrip1.AddItem "子菜单项2", 1 在每个菜单项和子菜单项的点击事件中,我们可以添加相应的代码来处理用户的选择。例如,可以在菜单项1的点击事件中添加以下代码: MsgBox "您选择了菜单项1" 最后,我们可以将UserForm显示为一个模态窗口,以便用户能够与多级菜单进行交互。例如,使用以下代码显示UserForm: UserForm1.Show vbModal 通过使用VBA的UserForm和MenuStrip控件,我们可以轻松地创建多级菜单,并在菜单项的点击事件中执行相应的操作。这样,用户就可以更方便地进行选择和操作。
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值