带递增编号的同名Excel工作表复制功能开发求助

原代码存在的主要问题： #

• Get_in函数中使用+连接字符串，VBA里字符串拼接应使用&，+会在单元格内容为数字时触发加法运算，导致结果错误。
• GetUniqueName函数的参数strProject未被使用，且构造带编号的名称时错误地将Funct.Get_in作为字符串拼接，实际应基于基础名称添加编号后缀。
• Test过程中硬编码新工作表名称Blank MAR (2)，多次复制后该名称会动态变化，无法正确定位到新创建的工作表。
• GetUniqueName中编号起始逻辑有误，首次检查应从2开始递增，确保编号连续合理。

修正后的完整代码： #

按钮执行代码（Test 过程）

Sub Test()
    Dim newSheet As Worksheet
    
    ' 复制模板工作表并直接获取新工作表对象
    Set newSheet = Sheets("Blank MAR").Copy(Before:=Sheets(1))
    
    ' 调用函数生成唯一名称并赋值给新工作表
    newSheet.Name = GetUniqueName(Get_in())
End Sub

辅助函数

' 获取基础名称：提取B1、C1首字母 + B2内容
Function Get_in() As String
    ' 明确指定数据源所在工作表，避免读取错误的单元格内容
    Get_in = Left(Sheets("Blank MAR").Range("B1"), 1) & Left(Sheets("Blank MAR").Range("C1"), 1) & " " & Sheets("Blank MAR").Range("B2").Value
End Function

' 根据基础名称生成唯一工作表名，存在同名则添加递增编号
Function GetUniqueName(baseName As String) As String
    Dim i As Long
    Dim candidateName As String
    
    ' 先检查基础名称是否可用
    If Not SheetNameExists(baseName) Then
        GetUniqueName = baseName
        Exit Function
    End If
    
    ' 若基础名称已存在，从2开始递增编号
    i = 2
    Do
        candidateName = baseName & " (" & i & ")"
        i = i + 1
    Loop While SheetNameExists(candidateName)
    
    GetUniqueName = candidateName
End Function

' 检查工作表名称是否已存在
Function SheetNameExists(strName As String) As Boolean
    Dim sh As Worksheet
    For Each sh In Worksheets
        ' 不区分大小写的名称比较
        If StrComp(sh.Name, strName, vbTextCompare) = 0 Then
            SheetNameExists = True
            Exit Function
        End If
    Next
    SheetNameExists = False
End Function

关键说明： #

1. 字符串拼接修正：将+替换为&，确保所有内容按字符串规则拼接，避免类型冲突。
2. 新工作表对象引用：通过Set newSheet = ...Copy(...)直接获取新创建的工作表，彻底避免硬编码名称导致的定位错误。
3. 唯一名称生成逻辑：先验证基础名称可用性，若已存在则从(2)开始依次尝试，直到找到未被使用的名称。
4. 明确数据源：在Get_in中指定数据源为Blank MAR工作表，确保读取的是模板中的目标单元格，可根据实际需求修改为对应工作表。

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