本文于2023年8月12日首发于本人同名公众号：Excel活学活用，更多文章案例请搜索关注！
内容提要
- 正则表达式提取数字加指定字符
- 字典方法汇总数据
大家好，我是冷水泡茶，今天在论坛上看到一个求助贴：
他的明细表数据是这样的：
他要在同一张表的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 = Nothing
End 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
Next
End 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---
喜欢就点个赞、点在看、留个言呗！分享一下更给力！感谢！