ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
12
返回列表 发新帖
楼主: yuanexl

[求助] vba 处理字符串

[复制链接]

TA的精华主题

TA的得分主题

发表于 2019-3-23 14:45 | 显示全部楼层
yuanexl 发表于 2019-3-23 14:38
工人4人,电焊机1台,吊车1辆,发电机1台,工人2人,电焊机1台,发电机1台
汇总结果:  
工人6人,电焊 ...


instr查找关键字,取后面数字,或者根据关键字,split拆分再取数字吧

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-3-23 14:50 | 显示全部楼层
liulang0808 发表于 2019-3-23 14:45
instr查找关键字,取后面数字,或者根据关键字,split拆分再取数字吧

工人4人,电焊机1台,吊车1辆,发电机1台,工人2人,电焊机1台,发电机1台

试了 做不出来  现在问题是 不知道 怎么 加
工人6人 做不出来

TA的精华主题

TA的得分主题

发表于 2019-3-23 15:08 | 显示全部楼层
本帖最后由 duquancai 于 2019-3-23 16:23 编辑
  1. Sub main()
  2.     Dim re As Object, d As Object, s$, mh As Object, r, res$
  3.     s = "工人4人,电焊机1台,吊车1辆,发电机1台,工人2人,电焊机1台,发电机1台"
  4.     Set re = CreateObject("VBScript.Regexp")
  5.     re.Global = True: re.Pattern = "([^\d,]+)(\d+)([^,]+)"
  6.     Set d = CreateObject("Scripting.Dictionary")
  7.     For Each mh In re.Execute(s)
  8.         s = mh.submatches(0) & "," & mh.submatches(2)
  9.         d(s) = d(s) + mh.submatches(1) * 1
  10.     Next
  11.     k = d.keys: i = d.items
  12.     For j = 0 To UBound(k)
  13.         r = Split(k(j), ",")
  14.         res = "," + r(0) + Str$(i(j)) + r(1) + res
  15.     Next
  16.     MsgBox Mid(res, 2)
  17. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-3-23 15:19 | 显示全部楼层
  1. Sub test()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     str1 = "工人4人,电焊机1台,吊车1辆,发电机1台,工人2人,电焊机1台,发电机1台"
  4.     arr = Split(str1, ",")
  5.     For j = 0 To UBound(arr)
  6.         str2 = ""
  7.         For i = 1 To Len(arr(j))
  8.             If Mid(arr(j), i, 1) Like "[0-9]" Then
  9.                 d(str2) = d(str2) + Val(Mid(arr(j), i))
  10.                 Exit For
  11.             Else
  12.                 str2 = str2 & Mid(arr(j), i, 1)
  13.             End If
  14.         Next i
  15.     Next j
  16.     str1 = ""
  17.     For j = 0 To d.Count - 1
  18.         str1 = str1 & "," & d.keys()(j) & d.items()(j) & "人"
  19.     Next j
  20.     MsgBox Mid(str1, 2)
  21. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-3-23 15:54 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2019-3-23 15:55 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
  1. Sub test()
  2.     Set d = CreateObject("Scripting.Dictionary")
  3.     k = Split(Range("a1"), ",")
  4.     For i = 0 To UBound(k)
  5.         n = 0
  6.         For j = 1 To Len(k(i))
  7.             If Val(Mid(k(i), j, 1)) > 0 Then n = 1: GoTo fenxie
  8.         Next
  9. fenxie:
  10.         If n = 1 Then
  11.             s = Val(Mid(k(i), j))
  12.             x = Replace(k(i), s, ":")
  13.             d(x) = d(x) + s
  14.         End If
  15.     Next
  16.     k = d.keys
  17.     For i = 0 To d.Count - 1
  18.         k(i) = Replace(k(i), ":", d.items()(i))
  19.     Next
  20.     [a3] = Join(k, ",")
  21.     Set d = Nothing
  22. End Sub
复制代码

评分

1

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-3-24 10:15 | 显示全部楼层
  1. Sub ex()
  2.     s = "工人4人,電焊機1台,吊車1輛,發電機1台,工人2人,電焊機1台,發電機1台"

  3.     Debug.Print
  4.     Debug.Print s
  5.     Debug.Print SumITEM(s)
  6. End Sub
  7. Function SumITEM(s)
  8.     Dim d As Object
  9.     Set d = CreateObject("Scripting.Dictionary")
  10.     For Each xItem In Split(s, ",")
  11.         For i = 1 To Len(xItem)
  12.             If Val(Mid(xItem, i)) > 0 Then n = Val(Mid(xItem, i)): Exit For
  13.         Next i
  14.         Key = Replace(xItem, n, "#"): d(Key) = d(Key) + n
  15.     Next
  16.     dkeys = d.keys: dItem = d.items: JoinKeys = Join(dkeys, ",")
  17.     For j = 0 To UBound(dkeys)
  18.         JoinKeys = Replace(JoinKeys, dkeys(j), Replace(dkeys(j), "#", dItem(j)))
  19.     Next
  20.     SumITEM = JoinKeys
  21. End Function
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-3-29 00:32 , Processed in 0.047326 second(s), 9 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表