如何用vba代码根据品名特征字填写对应的单位？

作者：绿色风分类：时间：2022-08-17 浏览：156

楼主 kevinchengcw	Q: 如何用vba代码根据品名特征字填写对应的单位？ A: 代码如下： Sub test() Dim Rules, Arr, Arrt, Result, N&, I&, T& Rules = Split("弯管,,根,接头,,个,管,弯管\|接头,米,支架,,根,穿钉,,副,积水,,套,拉力环,,个,成套,,套,口圈,,只,托铁,,块,盖,,只", ",") '设定规则数组,样式为:三个一组,分别是包含特征字,排除特征字,对应单位 Arr = Range([b7], Columns("B").Cells.Find("合计").Offset(-1)).Value '取得品名区域数据并赋值给数组 ReDim Result(LBound(Arr) To UBound(Arr), 1 To 1) '重定义结果数组的上标 For N = LBound(Arr) To UBound(Arr) '循环品名各项 If Arr(N, 1) <> "" Then '如果当前循环到的项不是空值,则 For I = LBound(Rules) To UBound(Rules) Step 3 '逐项匹配规则数组中各组规则(注意:步进为3,即每次一组范围) If Arr(N, 1) Like "" & Rules(I) & "" Then '如果与特征字匹配,则 Result(N, 1) = Rules(I + 2) '将对应单位赋值给结果数组对应位置 If Rules(I + 1) <> "" Then '如果排除特征字不为空,则 Arrt = Split(Rules(I + 1), "\|") '将可能存在的多个排除特征字依特定字符拆分放入数组 For T = LBound(Arrt) To UBound(Arrt) '循环排除特征字数组各项 If Arr(N, 1) Like "" & Arrt(T) & "" Then '如果与排除特征字数组中的内容匹配,则 Result(N, 1) = "" '清空结果数组对应内容 Exit For '跳出循环(即只要有一个排除特征字被匹配到,则匹配不成立,跳出循环,到下一个匹配组) End If Next T If Result(N, 1) <> "" Then Exit For '如果对排除特征字数组的循环结束后,结果数组依然不为空,则说明匹配成立,完成当前匹配,跳出循环,到下一个品名去 Else '如果排除特征字位置是空值,则跳出循环 Exit For End If End If Next I End If Next N [d7].Resize(UBound(Result), 1) = Result '结果写入对应数据区 End Sub 详见附件及素材源帖. vba代码智能加单位.rar
2楼 rongjun	学习了！
3楼亡者天下	过来学习一下
4楼 wise	xue xi
5楼芐雨	谢谢分享

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，经与ExcelTip.Net站长Apolloh商议并征得其同意，现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，供有需要的人士查询使用，也慰缅曾经的论坛时代。所示各个帖子的原作者如对版权有异议，可与本人沟通提出，或于本站点留言，我们会尽快处理。在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

评论列表