遍历Range创建新工作表时重名报错的VBA问题求助

核心原因分析 #

导致崩溃的直接原因是代码未准确判断目标工作表是否已存在，常见触发场景：

• 月份值格式不统一：比如部分单元格是日期格式（如2024/1/5）直接转文本时显示"1月"，部分是手动输入的"01月"，或者存在全半角/大小写差异（如"１月" vs "1月"）
• 判断逻辑有漏洞：比如依赖On Error Resume Next跳过错误但未正确重置状态，或者未遍历隐藏工作表
• 单元格含不可见字符：比如月份文本前后有空格、制表符，导致生成的工作表名称看似相同实际不同，后续遍历又误判为不存在

修正后的代码 #

以下代码统一处理格式、严格判断存在性、避免重复创建：

Sub SplitDataByMonth()
    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim sourceRange As Range
    Dim cell As Range
    Dim monthName As String
    Dim wsExists As Boolean
    
    ' 配置源表和数据范围（根据实际修改）
    Set sourceSheet = ThisWorkbook.Worksheets("数据源")
    Set sourceRange = sourceSheet.Range("A2:A100") ' 假设月份在A列，从第2行开始
    
    ' 关闭屏幕刷新提升效率
    Application.ScreenUpdating = False
    
    For Each cell In sourceRange
        ' 统一月份格式：兼容日期/文本单元格，输出标准"mm月"格式
        If IsDate(cell.Value) Then
            monthName = Format(cell.Value, "mm月")
        Else
            ' 清除全半角空格等不可见字符
            monthName = Trim(Replace(Replace(cell.Value, " ", ""), "　", ""))
            ' 补全为两位数字格式（如"1月"转"01月"）
            If Len(monthName) = 2 Then
                monthName = "0" & monthName
            End If
        End If
        
        ' 遍历所有工作表（含隐藏）判断是否存在
        wsExists = False
        For Each targetSheet In ThisWorkbook.Worksheets
            If targetSheet.Name = monthName Then
                wsExists = True
                Exit For
            End If
        Next targetSheet
        
        ' 不存在则创建，存在则直接引用
        If Not wsExists Then
            Set targetSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            targetSheet.Name = monthName
        Else
            Set targetSheet = ThisWorkbook.Worksheets(monthName)
        End If
        
        ' 复制当前行数据到目标表（假设数据范围是A-E列，按需修改）
        sourceSheet.Rows(cell.Row).Copy Destination:=targetSheet.Cells(targetSheet.Rows.Count, 1).End(xlUp).Offset(1, 0)
    Next cell
    
    Application.ScreenUpdating = True
    MsgBox "数据拆分完成"
End Sub

关键优化点 #

• 统一格式标准：不管源单元格是日期还是文本，都转为两位数字+月的标准格式，消除格式差异
• 严格存在性校验：遍历所有工作表（包括隐藏的），替代容错性差的错误跳过逻辑
• 清除隐形干扰：去除文本前后的全半角空格，避免因不可见字符导致的名称不一致

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