作者：绿色风
分类：
时间：2022-08-17
浏览：101
楼主
0Mouse |
Q：如何运用VBA根据单元格缩进级别判断父项所包含子项的数量呢？
如图1所示，A列A2以下单元格设置了不同级别的缩进，如何根据各单元格的缩进层级判断其所包含的子层级数量呢？预期效果如图2所示。
注意：A列的缩进层级大于三级以上
图1：初始效果
图2：预期效果
A：打开目标文档，按<Alt+F11>组合键，双击工程资源管理器窗格的“Sheet1”，在显示的空白窗口中录入以下代码，按<F5>键，完毕！- Sub 运用VBA根据单元格缩进级别判断父项所包含子项的数量()
- Dim Rng As Range, Rst, Dic As Object, oRng As Range, i&, x& '定义变量
- Set Rng = Range([A2], Cells(Rows.Count, 1).End(xlUp)) '令Rng变量指代A列从第2行开始到最后一个非空行的区域
- ReDim Rst(1 To Rng.Rows.Count, 1 To 2) '重新定义存放结果的二维数组Rst的上下界
- Set Dic = CreateObject("scripting.dictionary") '创建字典对象
- For Each oRng In Rng '循环Rng指定区域内的每一个单元格
- i = i + 1 '计数器变量加1
- Rst(i, 1) = 0 '在Rst数组的第1列第i行写入0
- With oRng '引用当前循环到的单元格对象
- Dim idl '定义变量用于存储单元格缩进级别，定义的同时也起到清空的作用
- idl = .IndentLevel '将单元格缩进级别赋值给变量idl
- If idl Then '如果缩进级别大于0
- If idl < .Offset(1).IndentLevel Then Dic(idl) = i '如果当前单元格的缩进级别数字小于下一个单元格，则将字典中idl对应的行号更新为变量i的值
- x = Dic(idl - 1) '将idl的父项idl-1对应的行号赋值给变量x
- Rst(x, 1) = Rst(x, 1) + 1 '数组中父项个数加1
- If .Value Like "*" & "[省市区]" Then '如果当前单元格文本的最后一个字符为“省”、“市”或“区”
- Rst(x, 2) = Rst(x, 2) & "、" & Left(.Value, Len(.Value) - 1) '将当前单元格文本不包含“省市区”的内容连接到数组中父项个数对应的说明项里
- Else '否则
- Rst(x, 2) = Rst(x, 2) & "、" & .Value '将当前单元格文本连接到数组中父项个数对应的说明项里
- End If
- x = 0 '将变量x重置为0
- Else '如果缩进级别为0，即无缩进
- Dic(idl) = i
- End If
- End With
- Next oRng
- For i = 1 To UBound(Rst) '循环Rst数组的每一行，根据第1列的数字加工第2列的文字
- If Rst(i, 1) Then '如果第1列第i行的数字大于0
- Rst(i, 2) = "包含" & Mid(Rst(i, 2), 2) & Rst(i, 1) & "个子项"
- Else '如果第1列第i行的数字等于0
- Rst(i, 2) = "包含0个子项"
- End If
- Next i
- Range("B2").Resize(Rows.Count - 1, 2).ClearContents '清空B、C列第2行以下的数据
- Range("B2").Resize(i - 1, 2).Value = Rst '将Rst数组存储的数据写入工作表目标位置
- Columns("B:C").AutoFit '使B、C两列自适应列宽
- End Sub
附件：
 运用VBA根据单元格缩进级别判断父项所包含子项的数量.rar
|
2楼
Agoni。 |
新人学习 |
3楼
芐雨 |
 正需要 |
4楼
jm9999 |
谢谢分享，牛！ |
5楼
老糊涂 |
谢谢分享 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一