多Excel命名表格中匹配ID并递增对应Mark值的宏开发需求

场景 #

• 存在多个结构一致的Excel命名表格（示例为Table901、Table902，实际可扩展至8个），每个表格均包含两列：ID（唯一数字编码）、Mark（正整数）
• 单元格Q43存储待匹配的ID，每次运行宏前会更换该ID值

需求 #

开发VBA宏，读取Q43中的ID，在所有目标表格中找到匹配的ID行，将对应Mark列的值递增1

已尝试方案的局限 #

使用公式=FILTER(Table901[Mark],Table901[ID]=Q43,FILTER(Table902[Mark],Table902[ID]=Q43))+1可计算出递增后的值，但无法直接修改原单元格，需手动定位修改，不适用于大量数据场景

解决方案：VBA宏代码 #

Sub IncrementMarkByID()
    Dim targetID As Long
    Dim tbl As ListObject
    Dim matchCell As Range
    Dim tableNames As Variant
    
    ' 定义所有目标表格名称，可直接扩展至8个表格
    tableNames = Array("Table901", "Table902")
    
    ' 读取Q43中的目标ID（替换Sheet1为实际工作表名称）
    targetID = ThisWorkbook.Sheets("Sheet1").Range("Q43").Value
    
    ' 遍历所有表格
    For Each tblName In tableNames
        Set tbl = ThisWorkbook.Sheets("Sheet1").ListObjects(tblName)
        
        ' 精准查找匹配ID的单元格
        Set matchCell = tbl.ListColumns("ID").DataBodyRange.Find( _
            What:=targetID, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False _
        )
        
        ' 找到匹配项则递增Mark值
        If Not matchCell Is Nothing Then
            ' 获取对应Mark列的单元格并递增
            tbl.ListColumns("Mark").DataBodyRange(matchCell.Row - tbl.HeaderRowRange.Row).Value = _
                tbl.ListColumns("Mark").DataBodyRange(matchCell.Row - tbl.HeaderRowRange.Row).Value + 1
            ' 若ID仅存在于一个表格，可取消下一行注释提前退出循环
            ' Exit For
        End If
    Next tblName
    
    MsgBox "操作完成：已为匹配ID的Mark值递增1（若找到匹配项）", vbInformation
End Sub

代码使用说明 #

• 扩展表格数量：在tableNames = Array("Table901", "Table902")中添加更多表格名称即可支持8个表格，例如Array("Table901", "Table902", "Table903", ..., "Table908")
• 工作表适配：将代码中的Sheet1替换为存储这些命名表格的实际工作表名称
• 匹配逻辑：采用完全匹配（LookAt:=xlWhole）确保仅匹配与Q43完全一致的ID
• 错误处理：未找到匹配ID时不会报错，宏会继续遍历其他表格

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