VBA遍历表格与多行If语句异常：仅最后一个表格执行完整逻辑

我写了一段VBA代码遍历当前工作表的所有ListObject表格，需求是：

• 当表格左上单元格显示“Enter Name”时，其右侧列及下方单元格需为空；
• 若左上单元格为具体名称，则将该名称复制到正下方单元格，且该单元格右侧显示“Enter Name”。

但目前代码仅对工作表最后一个表格执行完整的If语句逻辑，其余表格仅执行两条If语句的第一行，请问问题出在哪里？

公共变量代码 #

Option Explicit

Public WS As WorkSheet

Public Table As ListObject

Public HeaderRange As Range

Public Const sheet = "Sheet1"

Public tAds As String
Public Rng As String
Public TopLeft As String

Public LastRow As Long
Public LastColumn As Long

工作表事件代码 #

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Set WS = ActiveWorkbook.Worksheets(sheet)

    For Each Table In WS.ListObjects

        Set HeaderRange = Table.HeaderRowRange

        TopLeft = HeaderRange.Cells(1,1).Address(0,0)
        Rng = Range(TopLeft).Offset(1,0).Address(0,0)

        If Not Intersect(Target, Range(Rng)) Is Nothing Then
            Call ToName(Target)
        End If
    Next Table
End Sub

被调用的Sub代码 #

Option Explicit

Sub ToName(ByVal Target As Range)

If Range(Rng).Value = "" Then Range(Rng).Value = "Enter Name"

    If Range(Rng).Value <> "Enter Name" Then
        Sheets(sheet).Range(Rng).Offset(1,1).Value = "Enter Name" 
        Sheets(sheet).Range(Rng).Offset(1,0).Value = Range(Rng).Value
    Else
        If Range(Rng) = "Enter Name" Then
            Sheets(sheet).Range(Rng).Offset(1,1).Value = "" 
            Sheets(sheet).Range(Rng).Offset(1,0).Value = ""
        End If
    End If
End Sub

问题根源 #

核心问题出在公共变量Rng的全局覆盖：

1. 遍历表格时，每循环一次就会把当前表格的目标单元格地址赋值给Rng，循环结束后Rng只保留最后一个表格的单元格地址；
2. 触发Worksheet_Change事件时，前面的表格虽然能进入Intersect判断，但调用ToName时，Rng已经被最后一个表格的地址覆盖，导致所有表格的触发逻辑都用最后一个表格的Rng值执行，自然只有最后一个表格能正常运行。

修复方案 #

方案1：移除公共变量，通过参数传递目标单元格（推荐） #

直接操作触发事件的单元格，避免全局变量冲突：

修改后的工作表事件代码

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim WS As Worksheet
    Dim tbl As ListObject
    Dim headerRng As Range
    Dim targetCell As Range
    
    '禁用事件防止递归触发
    Application.EnableEvents = False
    On Error GoTo Cleanup

    Set WS = ActiveWorkbook.Worksheets("Sheet1")
    
    For Each tbl In WS.ListObjects
        Set headerRng = tbl.HeaderRowRange
        Set targetCell = headerRng.Cells(1, 1).Offset(1, 0)
        
        If Not Intersect(Target, targetCell) Is Nothing Then
            Call ToName(targetCell)
            Exit For '找到对应表格后直接退出循环，避免冗余操作
        End If
    Next tbl
    
Cleanup:
    Application.EnableEvents = True '恢复事件
End Sub

修改后的ToName代码

Option Explicit

Sub ToName(ByVal targetCell As Range)
    Dim ws As Worksheet
    Set ws = targetCell.Parent '直接获取单元格所在工作表，避免硬编码
    
    '处理空值情况
    If targetCell.Value = "" Then
        targetCell.Value = "Enter Name"
    End If
    
    '根据当前值执行逻辑
    If targetCell.Value <> "Enter Name" Then
        targetCell.Offset(1, 0).Value = targetCell.Value
        targetCell.Offset(1, 1).Value = "Enter Name"
    Else
        targetCell.Offset(1, 0).Value = ""
        targetCell.Offset(1, 1).Value = ""
    End If
End Sub

方案2：保留公共变量但传递正确值（不推荐） #

如果一定要用公共变量，需在调用ToName前确保Rng是当前表格的目标地址，但这种方式仍然存在全局变量冲突风险，不如方案1可靠。

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