基于表格内容创建工作表的VBA代码无效，求优化方案

原代码核心问题 #

你的SheetExists函数逻辑完全错误——它始终固定检查Sheet1是否存在，根本没用到传入的SheetName参数，导致永远返回True，自然不会创建任何新工作表。除此之外，原代码还有几个潜在隐患：

• 若表格Table1没有数据行，DataBodyRange会触发运行时错误
• 循环tbl.DataBodyRange.Cells会遍历所有单元格，若表格是多列结构会重复检查/创建
• 未处理非法工作表名称的情况（比如包含特殊字符、大小写差异导致的误判）

优化后的完整代码 #

Sub CreateSheetsFromList()
    Dim NewSheet As Worksheet
    Dim tbl As ListObject
    Dim tblRow As ListRow
    Dim sheetName As String
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False ' 关闭创建/重命名时的系统提示
    
    ' 绑定目标表格，先校验表格是否存在
    On Error Resume Next
    Set tbl = ThisWorkbook.Worksheets("Sheet1").ListObjects("Table1")
    On Error GoTo 0
    
    If tbl Is Nothing Then
        MsgBox "Sheet1中的Table1不存在，请检查表格名称！"
        GoTo Cleanup
    End If
    
    ' 检查表格是否有数据行
    If tbl.DataBodyRange Is Nothing Then
        MsgBox "Table1中没有数据，无需创建工作表！"
        GoTo Cleanup
    End If
    
    ' 遍历表格行（假设工作表名称在表格第一列，需调整则修改Range后的数字）
    For Each tblRow In tbl.ListRows
        sheetName = Trim(tblRow.Range(1).Value) ' 去除名称首尾空格
        If sheetName <> "" Then
            If Not SheetExists(sheetName) Then
                On Error Resume Next ' 捕获非法名称错误
                Set NewSheet = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                NewSheet.Name = sheetName
                If Err.Number <> 0 Then
                    MsgBox "无法创建工作表：" & sheetName & vbCrLf & "原因：" & Err.Description
                    NewSheet.Delete ' 删除创建的空白无效表
                End If
                On Error GoTo 0
            End If
        End If
    Next tblRow

Cleanup:
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Function SheetExists(sheetName As String) As Boolean
    Dim sht As Worksheet
    ' 遍历所有工作表，不区分大小写校验名称
    For Each sht In ThisWorkbook.Worksheets
        If UCase(sht.Name) = UCase(sheetName) Then
            SheetExists = True
            Exit Function
        End If
    Next sht
    SheetExists = False
End Function

关键改进说明 #

• 修复存在性检查：重写SheetExists函数，遍历所有工作表并忽略大小写校验，避免误判
• 增加错误防护：提前校验表格是否存在、是否有数据，避免运行时崩溃
• 优化遍历逻辑：直接遍历表格行，针对单列名称的场景更高效（需调整列数只需修改Range(1)的数字）
• 处理非法名称：添加错误捕获，遇到无法命名的情况会提示原因并清理无效表
• 提升运行体验：关闭屏幕刷新和系统提示，让代码运行更流畅，结束后恢复默认设置

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