作者：绿色风
分类：
时间：2022-08-17
浏览：126
楼主
kevinchengcw |
Q: 如何用vba代码获取科目最末级代码？
A: 代码如下：
- Sub test()
- Dim Dic As Object, Arr, I%, N&, Str$
- I = 4 '定义最初级科目代码长度,方便修改程序
- Arr = Range("a2:a" & Cells(Rows.Count, 1).End(3).Row).Formula '将科目列表数据放入数组
- Set Dic = CreateObject("scripting.dictionary") '创建字典项目
- For N = LBound(Arr) To UBound(Arr) '循环科目列表数据各项
- If Trim(Arr(N, 1)) <> "" Then '如果数据有效,则
- Str = Left(Arr(N, 1), I) '截取最初级段赋值给变量
- If Dic.exists(Str) Then '如果字典已存在该项目,则
- If Len(Arr(N, 1)) > Dic(Str) Then Dic(Str) = Len(Arr(N, 1)) '如果当前科目代码长度超过已有记录,则更新长度记录
- Else '否则将当前项目添加到字典中
- Dic.Add Str, Len(Arr(N, 1))
- End If
- End If
- Next N
- For N = LBound(Arr) To UBound(Arr) '再循环一次数据区,将科目中不是最末级长度的代码全部清空
- If Trim(Arr(N, 1)) <> "" Then
- Str = Left(Arr(N, 1), I)
- If Len(Arr(N, 1)) < Dic(Str) Then Arr(N, 1) = ""
- End If
- Next N
- With [e2].Resize(UBound(Arr)) '设定输出区域
- .NumberFormatLocal = "@" '设定单元格格式为文本
- .Value = Arr '输出结果
- End With
- Set Dic = Nothing '清空字典项目
- End Sub
详见附件及素材源帖.
 Demo.rar
|
2楼
xyf2210 |
学习 |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一