如何编写动态VBA循环 实现高级筛选后上下级数据按列转置

改造后代码 #

Dim StartRow As Long, StartCol As Long, UnderLevel2 As Long
Dim Member As Long, HeaderCol As Long, HeaderLastCol As Long

' 基础配置项，可根据实际排版需求调整
StartRow = 6 ' 成员信息填充的起始行
StartCol = 5 ' 第一个上级表头所在的列
UnderLevel2 = .Range("CI9999").End(xlUp).Row ' 数据源（高级筛选结果表）成员列的最大有效行，此处.需绑定你的数据源工作表对象
HeaderLastCol = ws.Cells(4, ws.Columns.Count).End(xlToLeft).Column ' 动态读取输出表第4行（表头行）的最大有效列，自动适配列数变动

' 外层循环：遍历所有数据源成员行
For Member = 2 To UnderLevel2
    ' 内层循环：遍历所有上级表头列，自动匹配成员对应的上级
    For HeaderCol = StartCol To HeaderLastCol Step 2 ' Step=2适配你当前间隔1列放一个上级表头的排版规则
        If ws.Cells(4, HeaderCol).Value = .Range("CU" & Member).Value Then
            ws.Cells(StartRow, HeaderCol).Value = .Range("CI" & Member).Value
            Exit For ' 匹配成功后跳出内层循环，提升运行效率
        End If
    Next HeaderCol
    StartRow = StartRow + 2 ' 按你的原有逻辑，成员行间隔1行填充
Next Member

逻辑说明 #

• 去掉了原有硬编码的列偏移判断逻辑，改为动态读取表头行的所有有效列，支持新增/删除上级表头后自动适配，不需要修改代码
• 内层循环的Step 2匹配你现有表头间隔1列的排版，若后续改为连续列排版，删除该参数即可
• 保留了你原有的成员行间隔1行填充的业务规则，若需要改为连续行填充，将StartRow = StartRow + 2修改为StartRow = StartRow + 1即可

使用注意事项 #

• 运行前请确认已正确绑定两个工作表对象：ws为你要输出转置结果的工作表，代码中的.为存储高级筛选结果的数据源工作表
• 筛选结果变动后直接重新运行代码即可自动完成匹配填充

内容的提问来源于stack exchange，提问作者Jed Santos