Excel 2003宏运行异常求助：修改表名及字段后无结果输出

嘿，我来帮你解决这个宏罢工的问题！先理清楚你的情况：
你手里有个Excel 2003文档，一共9张工作表——8张对应各个场地（Parc），第9张是结果统计页。之前点“Obtener datos”按钮执行宏，能在结果表统计每位员工的GF、GP数量，还能显示姓名、场地编号（Parcnumber）这些信息。但你做了两个改动后，宏直接躺平了：一是把所有工作表里的Parcnumber字段改成了Parcname，二是改了场地工作表的名称，现在结果表啥内容都没有了。

问题根源很明确：宏的代码里还在引用旧的字段名和工作表名称，只要把代码里的对应内容改成新的，就能让它重新跑起来。下面分步骤给你说怎么改：

1. 替换字段名：把Parcnumber改成Parcname #

原来的代码里肯定到处都是Parcnumber的引用，现在你把字段名改成了Parcname，必须把这些引用全部替换掉。
比如如果代码里有这样的查找字段的行：

Set rngParc = ws.Cells.Find(What:="Parcnumber", LookIn:=xlValues, LookAt:=xlWhole)

就改成：

Set rngParc = ws.Cells.Find(What:="Parcname", LookIn:=xlValues, LookAt:=xlWhole)

注意要检查代码里所有提到Parcnumber的地方，包括直接引用列的逻辑（如果有的话），确保拼写完全一致，别漏了大小写或者空格。

2. 修正工作表名称的匹配逻辑 #

你改了8个场地工作表的名称，宏原来应该是按旧名称来识别要统计的表的，比如原来可能是找名字以Parc开头的表：

For Each ws In ThisWorkbook.Worksheets
    If ws.Name Like "Parc*" Then
        ' 处理数据的代码
    End If
Next ws

现在表名改了，就得调整这个判断条件，让宏能正确找到那8个场地表：

• 如果新表名里都包含某个关键词（比如“场地”），就改成：

For Each ws In ThisWorkbook.Worksheets
    ' 排除结果表，只处理带关键词的场地表
    If ws.Name Like "*场地*" And ws.Name <> "结果表" Then
        ' 处理数据的代码
    End If
Next ws

• 如果新表名是固定的（比如“巴黎场地”“伦敦场地”这类），也可以直接把表名列出来遍历：

Dim targetSheets As Variant
targetSheets = Array("巴黎场地", "伦敦场地", "柏林场地", "马德里场地", "罗马场地", "阿姆斯特丹场地", "布鲁塞尔场地", "里斯本场地")
For Each sheetName In targetSheets
    Set ws = ThisWorkbook.Worksheets(sheetName)
    ' 处理数据的代码
Next sheetName

3. 调试验证，排查细节问题 #

改完上面的部分后，别直接点按钮执行，按F8一步步跑宏，看看哪里出问题：

• 检查Find方法有没有找到Parcname字段：如果rngParc显示为Nothing，说明工作表里的字段名和代码里的不一样（比如多了空格、大小写不同），要对齐拼写。
• 检查循环有没有遍历到所有场地表：如果某个表没被处理，就是工作表名称的判断条件不对，调整关键词或者表名列表。
• 检查结果表的写入逻辑：看看是不是因为字段位置变化，导致数据写到了看不见的地方，或者数据为空。

4. 给你个修正后的代码示例 #

假设原来的代码是类似下面这样，我给你改成适配新字段和表名的版本，你可以参考着改自己的代码：

原来的旧代码片段 #

Option Explicit
Sub ObtenerDatos()
    Dim ws As Worksheet
    Dim wsResult As Worksheet
    Dim rngName As Range, rngGF As Range, rngGP As Range, rngParc As Range
    Dim lastRow As Long, resultRow As Long
    
    Set wsResult = ThisWorkbook.Worksheets("结果表")
    resultRow = 2 ' 结果表从第二行开始写数据
    
    ' 清空结果表旧数据
    wsResult.Range("A2:Z" & wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    For Each ws In ThisWorkbook.Worksheets
        ' 匹配旧的Parc开头的表
        If ws.Name Like "Parc*" Then
            ' 查找旧字段Parcnumber
            Set rngParc = ws.Cells.Find(What:="Parcnumber", LookIn:=xlValues, LookAt:=xlWhole)
            Set rngName = ws.Cells.Find(What:="姓名", LookIn:=xlValues, LookAt:=xlWhole)
            Set rngGF = ws.Cells.Find(What:="GF", LookIn:=xlValues, LookAt:=xlWhole)
            Set rngGP = ws.Cells.Find(What:="GP", LookIn:=xlValues, LookAt:=xlWhole)
            
            If Not rngParc Is Nothing And Not rngName Is Nothing Then
                lastRow = ws.Cells(ws.Rows.Count, rngName.Column).End(xlUp).Row
                ' 遍历数据行写入结果表
                For i = rngName.Row + 1 To lastRow
                    wsResult.Cells(resultRow, "A").Value = ws.Cells(i, rngName.Column).Value
                    wsResult.Cells(resultRow, "B").Value = ws.Cells(i, rngParc.Column).Value
                    wsResult.Cells(resultRow, "C").Value = ws.Cells(i, rngGF.Column).Value
                    wsResult.Cells(resultRow, "D").Value = ws.Cells(i, rngGP.Column).Value
                    resultRow = resultRow + 1
                Next i
            End If
        End If
    Next ws
End Sub

修改后的新代码 #

Option Explicit
Sub ObtenerDatos()
    Dim ws As Worksheet
    Dim wsResult As Worksheet
    Dim rngName As Range, rngGF As Range, rngGP As Range, rngParc As Range
    Dim lastRow As Long, resultRow As Long, i As Long
    
    Set wsResult = ThisWorkbook.Worksheets("结果表")
    resultRow = 2 ' 结果表从第二行开始写数据
    
    ' 清空结果表旧数据（保留表头）
    wsResult.Range("A2:Z" & wsResult.Cells(wsResult.Rows.Count, "A").End(xlUp).Row).ClearContents
    
    For Each ws In ThisWorkbook.Worksheets
        ' 匹配新的带"场地"关键词的表，排除结果表
        If ws.Name Like "*场地*" And ws.Name <> wsResult.Name Then
            ' 查找新字段Parcname
            Set rngParc = ws.Cells.Find(What:="Parcname", LookIn:=xlValues, LookAt:=xlWhole)
            Set rngName = ws.Cells.Find(What:="姓名", LookIn:=xlValues, LookAt:=xlWhole)
            Set rngGF = ws.Cells.Find(What:="GF", LookIn:=xlValues, LookAt:=xlWhole)
            Set rngGP = ws.Cells.Find(What:="GP", LookIn:=xlValues, LookAt:=xlWhole)
            
            ' 检查所有必要字段是否存在
            If Not rngParc Is Nothing And Not rngName Is Nothing And Not rngGF Is Nothing And Not rngGP Is Nothing Then
                lastRow = ws.Cells(ws.Rows.Count, rngName.Column).End(xlUp).Row
                ' 遍历数据行写入结果表
                For i = rngName.Row + 1 To lastRow
                    wsResult.Cells(resultRow, "A").Value = ws.Cells(i, rngName.Column).Value
                    wsResult.Cells(resultRow, "B").Value = ws.Cells(i, rngParc.Column).Value
                    wsResult.Cells(resultRow, "C").Value = ws.Cells(i, rngGF.Column).Value
                    wsResult.Cells(resultRow, "D").Value = ws.Cells(i, rngGP.Column).Value
                    resultRow = resultRow + 1
                Next i
            Else
                ' 字段缺失时弹出提示，方便排查
                MsgBox "工作表「" & ws.Name & "」中缺少必要字段，请检查！"
            End If
        End If
    Next ws
    MsgBox "数据统计完成！一共写入了" & resultRow - 2 & "条数据"
End Sub

你可以根据自己实际的工作表名称、字段位置，调整上面代码里的匹配条件和写入逻辑。改完后记得先备份文档，再测试宏，确保一切正常。

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