如何在表格名称匹配公司ID单元格值时运行VBA统计代码？

问题背景 #

每个公司对应一个以CompanyX（如Company1、Company2）命名的ListObject表格，表格记录给单个/多个经理的警告，分为light（轻微）和severe（严重）两类，需要统计每位经理的两类警告次数（同一警告对应多位经理时写在同一单元格）。

现有VBA代码已实现公司ID生成逻辑，但统计逻辑是遍历固定列而非对应表格，导致同名经理的警告被跨公司重复统计。需要实现仅当ListObject名称匹配对应公司ID单元格值时，针对该表格执行统计，避免重复计数。

原尝试的遍历ListObject代码片段存在条件判断错误：

Dim co as ListObject
For each co In ActiveSheet.ListObjects
If ListObject.name = Range(rcell3).Offset(3,0).Value Then
''Run the code 2

原完整统计代码 #

Sub TesteA3()
'code 1:Set ID number for each company (company names can change so I needed a fixed ID)
Dim rcell As Range
Dim rrng As Range
Set rrng = Range("A2:A800")
'Since I'm using a sum to diffentiate the ID, I make sure to clear the range before any
Range("C2:E800").ClearContents
For Each rcell In rrng
    If rcell.Value = rcell.Offset(-1, 0).Value And IsEmpty(rcell) = False Then
        rcell.Offset(0, 5).Value = rcell.Offset(-1, 5).Value
    ElseIf rcell.Value <> rcell.Offset(-1, 0).Value And IsEmpty(rcell) = False Then
        rcell.Offset(0, 5).Value = rcell.Offset(-1, 5).Value + 1
    Else: If IsEmpty(rcell.Value) = True Then GoTo proximo
    End If
proximo:
Next rcell
'code 3:Sets an actual ID for each company. Since I'll use these ID's on the table later, I need them to not be plain numbers
Dim ncell As Range
Dim rrng2 As Range
Set rrng2 = Sheets("Sheet1").Range("F2:F800")
For Each ncell In rrng2
    If IsEmpty(ncell) = False Then
        ncell.Offset(0, -1).Value = "Company" & ncell.Value
        ncell.Clear
    Else
        GoTo proximo4
    End If
proximo4:
Next ncell
'code 3: Checks the erros and counts them
Dim rcell3 As Range
Dim rcell2 As Range
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Range("B2:B12")
Set rng2 = Range("I3:I12")
For Each rcell3 In rng1
    For Each rcell2 In rng2
        If InStr(1, rcell2.Value, rcell3.Value) > 0 And rcell2.Offset(0, -2).Value = "X" Then
            rcell3.Offset(0, 1).Value = rcell3.Offset(0, 1).Value + 1
        ElseIf InStr(1, rcell2.Value, rcell3.Value) > 0 And rcell2.Offset(0, -1).Value = "X" Then
            rcell3.Offset(0, 2).Value = rcell3.Offset(0, 2).Value + 1
        End If
    Next rcell2
Next rcell3
End Sub

修正方案 #

核心问题是遍历ListObject时的条件判断错误，以及统计逻辑未绑定对应公司表格。以下是修正后的代码，实现按公司ID匹配ListObject，仅统计对应表格内的警告：

Sub TesteA3_Fixed()
    'code 1:Set ID number for each company (company names can change so I needed a fixed ID)
    Dim rcell As Range
    Dim rrng As Range
    Set rrng = Range("A2:A800")
    Range("C2:E800").ClearContents
    For Each rcell In rrng
        If Not IsEmpty(rcell) Then
            If rcell.Value = rcell.Offset(-1, 0).Value Then
                rcell.Offset(0, 5).Value = rcell.Offset(-1, 5).Value
            Else
                rcell.Offset(0, 5).Value = rcell.Offset(-1, 5).Value + 1
            End If
        End If
proximo:
    Next rcell
    
    'code 2:Sets an actual ID for each company. Since I'll use these ID's on the table later, I need them to not be plain numbers
    Dim ncell As Range
    Dim rrng2 As Range
    Set rrng2 = Sheets("Sheet1").Range("F2:F800")
    For Each ncell In rrng2
        If Not IsEmpty(ncell) Then
            ncell.Offset(0, -1).Value = "Company" & ncell.Value
            ncell.Clear
        End If
proximo4:
    Next ncell
    
    'code 3: Checks the errors and counts them - 按公司ListObject匹配统计
    Dim targetCompanyID As String
    Dim co As ListObject
    Dim managerName As String
    Dim warningRow As ListRow
    Dim lightColIndex As Integer, severeColIndex As Integer
    Dim managerRng As Range
    
    ' 经理列表范围（B2:B12）
    Set managerRng = Range("B2:B12")
    
    ' 遍历每个公司的ListObject
    For Each co In ActiveSheet.ListObjects
        targetCompanyID = co.Name ' 当前表格对应的公司ID
        
        ' 找到对应公司ID的行（假设E列是公司ID，与B列经理一一对应）
        For Each rcell In managerRng.Offset(0, 3) ' E列对应B列偏移3列
            If rcell.Value = targetCompanyID Then
                managerName = rcell.Offset(0, -3).Value ' 获取对应经理名称（B列）
                
                ' 获取表格中light和severe列的索引（根据实际表头调整）
                lightColIndex = co.ListColumns("light").Index
                severeColIndex = co.ListColumns("severe").Index
                
                ' 遍历当前表格的每一行警告记录
                For Each warningRow In co.ListRows
                    ' 检查当前行的经理单元格是否包含目标经理名称
                    If InStr(1, warningRow.Range.Cells(1, co.ListColumns("Managers").Index).Value, managerName) > 0 Then
                        ' 统计light警告
                        If warningRow.Range.Cells(1, lightColIndex).Value = "X" Then
                            rcell.Offset(0, -2).Value = rcell.Offset(0, -2).Value + 1 ' C列（light计数）
                        End If
                        ' 统计severe警告
                        If warningRow.Range.Cells(1, severeColIndex).Value = "X" Then
                            rcell.Offset(0, -1).Value = rcell.Offset(0, -1).Value + 1 ' D列（severe计数）
                        End If
                    End If
                Next warningRow
            End If
        Next rcell
    Next co
End Sub

关键修正点 #

• 遍历ListObject时，使用循环变量co.Name而非错误的ListObject.name进行条件判断
• 将统计逻辑绑定到对应公司的ListObject，仅遍历当前匹配表格内的行，彻底避免跨公司统计同名经理
• 优化原代码的空值判断逻辑，简化冗余的分支结构
• 通过ListColumns索引定位警告类型列，避免依赖固定列偏移，提升代码健壮性

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