如何修改VBA宏在数组中搜索指定字符串并返回对应最大值

现有数据包含Equipment Name（设备名称）、**Equipment ID（设备ID）**及对应编号列，原VBA宏可按Equipment ID生成对应最高编号表。现需修改宏，仅筛选设备名称包含指定字符串（如"Asset"）的记录，再生成这些记录对应的Equipment ID的最高编号表。

原宏代码如下：

Sub ExtractMaxPerEquipment()
 Dim ws As Worksheet, lastR As Long, arr, arrFin, i As Long, dict As Object
 
 Set ws = ActiveSheet 'use here the necessary sheet
 lastR = ws.Range("A" & ws.rows.count).End(xlUp).row 'last row in A:A
 
 arr = ws.Range("A2:B" & lastR).Value2 'place the range in an array for faster processing
 
 Set dict = CreateObject("Scripting.Dictionary") 'set the necessary dictionary
 For i = 1 To UBound(arr) 'iterate between the array rows
    dict(arr(i, 1)) = Application.Max(endNo(CStr(arr(i, 2))), dict(arr(i, 1))) 'load the dictionary
 Next i
 
 arrFin = Application.Transpose(Array(dict.keys, dict.Items)) 'combine the dictionary keys and items in an array
 
 ws.Range("D2").Resize(UBound(arrFin), 2).Value2 = arrFin 'drop the final array content in "D2"
End Sub

Function endNo(x As String) As String
    If x = "" Then endNo = 0: Exit Function
    With CreateObject("vbscript.regexp")
        .Pattern = "\d{1,5}?.*$"
        .Global = False
        endNo = .Execute(x)(0)
    End With
End Function

Sub ExtractMaxForMatchingEquipmentName()
    Dim ws As Worksheet, lastR As Long, arr, arrFin, i As Long, dict As Object
    Dim searchStr As String, eqNameCol As Integer, eqIDCol As Integer, numCol As Integer
    
    ' -------------------------- 可配置参数 --------------------------
    searchStr = "Asset"       ' 要搜索的目标字符串
    eqNameCol = 1             ' 设备名称所在列（A=1，B=2，以此类推）
    eqIDCol = 2               ' 设备ID所在列
    numCol = 3                ' 编号所在列
    Set ws = ActiveSheet      ' 目标工作表（可改为Sheets("你的表名")）
    ' ----------------------------------------------------------------
    
    ' 获取设备名称列的最后一行
    lastR = ws.Cells(ws.Rows.Count, eqNameCol).End(xlUp).Row
    ' 加载包含设备名称、ID、编号的数组
    arr = ws.Range(ws.Cells(2, eqNameCol), ws.Cells(lastR, numCol)).Value2
    
    Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare ' 不区分大小写比较
    
    For i = 1 To UBound(arr)
        ' 检查当前行设备名称是否包含指定字符串
        If InStr(1, CStr(arr(i, 1)), searchStr, vbTextCompare) > 0 Then
            ' 提取编号中的数字并转为数值型
            Dim currentNum As Long
            currentNum = CLng(endNo(CStr(arr(i, 3))))
            
            ' 更新字典：存在则取最大值，不存在则新增
            If dict.Exists(arr(i, 2)) Then
                dict(arr(i, 2)) = Application.Max(currentNum, dict(arr(i, 2)))
            Else
                dict(arr(i, 2)) = currentNum
            End If
        End If
    Next i
    
    ' 输出结果到D、E列
    If dict.Count > 0 Then
        arrFin = Application.Transpose(Array(dict.Keys, dict.Items))
        ws.Range("D2").Resize(UBound(arrFin), 2).Value2 = arrFin
        ' 自动添加表头
        ws.Range("D1").Value = "匹配的Equipment ID"
        ws.Range("E1").Value = "对应最高编号"
    Else
        MsgBox "未找到包含""" & searchStr & """的设备名称记录！"
    End If
End Sub

Function endNo(x As String) As String
    If x = "" Then endNo = 0: Exit Function
    With CreateObject("vbscript.regexp")
        .Pattern = "\d{1,5}?.*$"
        .Global = False
        endNo = .Execute(x)(0)
    End With
End Function

• 可配置化设计：顶部预留核心参数，可根据实际表格结构调整列号、搜索字符串和目标工作表，无需修改核心逻辑。
• 筛选逻辑添加：通过InStr函数实现设备名称的模糊匹配，仅处理符合条件的记录。
• 字典操作优化：明确判断设备ID是否已存在，避免原代码中初始值默认0的潜在问题；设置vbTextCompare实现不区分大小写的搜索与键比较（如需区分大小写，改为vbBinaryCompare即可）。
• 用户反馈增强：无匹配记录时弹出提示，避免空输出造成误解。
• 表头自动生成：为输出列添加明确表头，提升可读性。

内容的提问来源于stack exchange，提问作者Rick G