Excel VBA通过文本框输入动态设置工作表引用并替换公式旧引用

核心实现逻辑 #

针对需求直接落地：

• 工作表复制操作完成后，新生成的工作表会自动成为当前活动工作表，直接将活动工作表赋值给对象变量即可，无需后续通过硬编码表名重新取对象
• 重命名新工作表、新工作表内的列表对象（ListObject）前，先记录原工作表名、原列表对象名，重命名后遍历新表所有公式单元格，批量替换公式内残留的旧引用即可

修正后完整可运行代码 #

Sub Button1_Click()
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim oldSheetName As String
    Dim oldTblName As String
    Dim shName As String
    Dim tblName As String
    Dim c As Range
    
    ' 绑定当前工作簿对象
    Set wb = ThisWorkbook
    
    ' 记录原工作表（被复制的Sheet1）的名称和自带表名
    oldSheetName = Sheet1.Name
    oldTblName = Sheet1.ListObjects(1).Name
    
    ' 执行复制操作，新表插入到Sheet3之前
    Sheet1.Copy Before:=Sheet3
    ' 复制完成后新表自动激活，直接绑定对象变量，无需硬编码名称
    Set ws = ActiveSheet
    
    ' 获取用户输入的新名称
    shName = InputBox("What is the sheet name?")
    ' 点取消直接退出过程
    If shName = "" Then Exit Sub
    tblName = InputBox("What is the table name?")
    If tblName = "" Then Exit Sub
    
    ' 关闭屏幕更新提升运行速度
    Application.ScreenUpdating = False
    
    ' 修改新工作表名称
    ws.Name = shName
    ' 修改新工作表内列表对象名称
    ws.ListObjects(1).Name = tblName
    
    ' 批量替换公式内的旧引用
    For Each c In ws.UsedRange
        If c.HasFormula Then
            ' 替换公式里的旧工作表引用，兼容带单引号的跨表引用格式
            c.Formula = Replace(c.Formula, "'" & oldSheetName & "'!", "'" & shName & "'!")
            c.Formula = Replace(c.Formula, oldSheetName & "!", shName & "!")
            ' 替换公式里的旧列表对象结构化引用，匹配[前缀避免误替换普通文本
            c.Formula = Replace(c.Formula, oldTblName & "[", tblName & "[")
        End If
    Next c
    
    ' 恢复屏幕更新
    Application.ScreenUpdating = True
    
    ' 后续需要操作新表直接用ws对象即可，示例：
    ' ws.ListObjects(1).ListColumns("Colors").DataBodyRange.Formula = ""
End Sub

关键注意事项 #

• 原代码存在语法错误：Dim ws As Worksheets 类型声明错误，正确类型为单数Worksheet；工作簿对象wb必须显式赋值为ThisWorkbook，否则会因对象未初始化报错
• 公式替换环节只处理带HasFormula标记的单元格，不会改动单元格内存储的普通文本内容
• 替换列表对象引用时匹配旧表名[的结构化引用特征，不会误替换单元格内和旧表名重名的普通文本
• 如果需要处理其他工作表内指向本次复制生成的新表的公式，可遍历全工作簿所有工作表的公式区域执行相同替换逻辑即可

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