本文于2023年8月12日首发于本人同名其他平台，更多文章案例请搜索关注！
内容提要
正则表达式提取数字加指定字符
字典方法汇总数据
大家好，我是冷水泡茶，今天在论坛上看到一个求助贴：
他的明细表数据是这样的：
他要在同一张表的B29、C29列写入数据：
他的具体需求是：把B列包含“??芯"项目，对应的G列数据进行汇总，并且用进一法舍入到10位，并且要把29行以下，C列为0的行删除。
其实，在实际工作中碰到类似问题，添加辅助列或者对照表都是不错的选择，但楼主不想添加辅助列，只想用VBA代码来解决，那么，从研究VBA代码的角度，还是值得探讨探讨的，我们一起来看一看吧：
基本思路
1、首先，我们分析关键字特征，它是不确定的几位数字加上一个“芯”。
2、然后，我又发现，它的项目字段中，只有一段连续的数字，没有其他数字。
3、我突然想起我们前面分享过的文章，正则表达式提取数字【Excel VBA 提取数字/自定义工作表函数/正则表达式/批量提取电话号码】，还有一篇【Excel VBA 提取单元格字符串中的数字并求和/兼聊原始数据的问题】。
4、我们用前文中分享过的函数GetNum把所有数字提取出来，再加上一个“芯”字，不就成了？试了一下，确实可行。但是感觉直接用这种方法，有点偷机取巧的意思，不算正解。
5、正确的思路应该是，用正则表达式把“芯”前面的数字及“芯”字提取出来。
程序代码
1、自定义函数ExtractKey，提取汇总关键字：
Function ExtractKey(str As String) Dim regex As Object Dim matches As Object Dim strResult As String ' 创建正则表达式对象 Set regex = CreateObject("VBScript.RegExp") regex.Global = True regex.IgnoreCase = True regex.Pattern = "\d+芯" ' 执行正则匹配 Set matches = regex.Execute(str) ' 提取第一个匹配结果 If matches.Count > 0 Then strResult = matches.Item(0).Value Else strResult = "" End If ExtractKey = strResult ' 清除对象引用 Set regex = Nothing Set matches = NothingEnd Function
代码解析：
（1）创建正则表达式对象regex 。
（2）定义模式：regex.Pattern = "\d+芯"，表示匹配“芯”及其前面的所有连续的数字。
（3）执行匹配Set matches = regex.Execute(str)。
（4）提取匹配结果给自定义函数赋值。
2、Sum过程，按提取关键字汇总数据：
Sub Sum() Dim arr() Dim ws As Worksheet Dim lastRow As Integer Dim Dic As Object Dim dKey As String Dim iCol As Integer Dim arrTem() ThisWorkbook.Activate Set ws = Sheets("线路定额") Set Dic = CreateObject("Scripting.dictionary") ws.Activate lastRow = 28 arr = ws.Range(Cells(2, 2), Cells(lastRow, 7)).Value iCol = UBound(arr, 2) For i = 1 To UBound(arr, 1) If InStr(arr(i, 1), "芯") > 0 Then dKey = arr(i, 1) dKey = ExtractKey(dKey) Dic(dKey) = Dic(dKey) + arr(i, iCol) End If Next lastRow = ws.UsedRange.Rows.Count ws.Range("B29:C" & lastRow).ClearContents arrTem = Dic.keys ws.Range("B29").Resize(UBound(arrTem) + 1, 1) = Application.WorksheetFunction.Transpose(arrTem) arrTem = Dic.items '取整 For i = LBound(arrTem) To UBound(arrTem) arrTem(i) = Application.WorksheetFunction.Ceiling(arrTem(i), 10) Next ws.Range("C29").Resize(UBound(arrTem) + 1, 1) = Application.WorksheetFunction.Transpose(arrTem) '删除C列单元格为0的行 lastRow = ws.UsedRange.Rows.Count For i = lastRow To 29 Step -1 If Cells(i, 3) = 0 Then Rows(i).Delete End If NextEnd Sub
代码解析：
（1）定义字典Dic。
（2）把原始数据读入数组，他要求在第29行写入数据，所以把lastRow定为28。（我想不出原因为什么要在同一张表上进行汇总，要是我做的话，肯定是把汇总数据放到另外一张表上。）
（3）循环数组，提取汇总关键字“?芯”，这里用同一个变量dkey，逐步取得结果。
（4）把关键字装入字典，顺带进行汇总，把汇总结果存在字典的Item里。
（5）把字典的keys赋值给数组arrTem，再把arrTem存入工作表B列。
（6）把字典的items赋值给数组arrTem，用工作表函数ceiling把数组的值取整到10位后，再存入工作表C列。
（7）删除第29行以下，C列为0的记录。删除行要从下往上删除。
总结
1、字符提取，用正则表达式，非常方便。
2、字段汇总，用字典，可以在向字典添加键值的同时进行汇总。
---End---
喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！