请求优化Excel VBA：新增客户时自动复制模板并查重

需求 #

• 当Summary工作表A列（客户名称）新增条目时，自动复制Template模板工作表，将新工作表命名为该客户名称，并在Summary的对应单元格建立指向新工作表的链接
• 若已存在同名工作表，弹出提示：已创建过名为‘[客户名称]’的模板

原代码问题 #

你提供的代码仅能一次性批量处理A列所有客户名称，无法在A列新增条目时自动触发执行，不符合实时响应的需求。

修改后的完整代码 #

将以下代码粘贴到Summary工作表的代码模块中（右键点击Summary工作表标签 → 查看代码）：

' 检查工作表是否存在的辅助函数
Function SheetExists(shtName As String, Optional wb As Workbook) As Boolean
    Dim sht As Worksheet
    If wb Is Nothing Then Set wb = ThisWorkbook
    On Error Resume Next
    Set sht = wb.Sheets(shtName)
    On Error GoTo 0
    SheetExists = Not sht Is Nothing
End Function

' 监听Summary工作表的单元格变更事件
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim templateWS As Worksheet
    Dim newWS As Worksheet
    
    ' 只处理A列（客户名称列）的变更，且排除表头行（假设表头在A1）
    Set rng = Intersect(Target, Me.Columns("A"), Me.Rows("2:" & Me.Rows.Count))
    If rng Is Nothing Then Exit Sub
    
    Set templateWS = ThisWorkbook.Sheets("Template")
    If templateWS Is Nothing Then
        MsgBox "模板工作表'Template'不存在，请检查！", vbCritical
        Exit Sub
    End If
    
    ' 遍历所有变更的单元格
    For Each cell In rng
        ' 只处理非空的新增条目
        If Trim(cell.Value) <> "" Then
            ' 检查是否已存在同名工作表
            If SheetExists(cell.Value) Then
                MsgBox "已创建过名为‘" & cell.Value & "’的模板", vbInformation
            Else
                ' 复制模板工作表到最后
                templateWS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                Set newWS = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
                
                ' 重命名新工作表，处理可能的命名错误
                On Error Resume Next
                newWS.Name = cell.Value
                If Err.Number <> 0 Then
                    MsgBox "无法将工作表命名为‘" & cell.Value & "’，名称包含非法字符或过长", vbCritical
                    newWS.Delete
                    On Error GoTo 0
                    Exit For
                End If
                On Error GoTo 0
                
                ' 在Summary对应单元格添加指向新工作表的链接
                Me.Hyperlinks.Add Anchor:=cell, Address:="", _
                    SubAddress:="'" & newWS.Name & "'!A2", TextToDisplay:=cell.Value
            End If
        End If
    Next cell
End Sub

代码说明 #

1. 事件触发逻辑：通过Worksheet_Change事件监听Summary工作表的单元格变化，仅对A列（从第2行开始，排除表头）的变更做出响应
2. 有效性检查：
   • 先确认Template模板工作表存在，避免触发无效操作
   • 只处理非空单元格，防止空值引发错误
3. 工作表存在性判断：调用SheetExists函数检查，若已存在同名工作表则直接弹出提示，不重复创建
4. 工作表创建与链接：
   • 复制模板到工作簿末尾
   • 处理重命名可能出现的错误（如名称含非法字符、过长），失败则自动删除新建的无效工作表
   • 在Summary的客户名称单元格添加指向新工作表A2单元格的超链接

内容的提问来源于stack exchange，提问作者Guilherme Provenzano Zimmerman