For Each循环中整列Range触发Type Mismatch Error问题

你碰到的类型不匹配错误，核心原因有两个：

• 整列（E:E）包含1048576行，循环时会碰到非日期格式的单元格（比如空白单元格带隐藏公式、纯文本内容），Month()函数无法处理非日期值，直接触发报错
• 遍历整列效率极低，完全没必要处理大量空行

修复步骤： #

1. 先定位E列实际有数据的最后一行，缩小循环范围，避免无效遍历
2. 增加日期有效性判断，确保只有日期类型的单元格才调用Month()函数

修正后的完整代码： #

Sub SplitEachMonthToSubFodlers()
    Dim FPath As String
    Dim ws As Worksheet
    Dim xRgDate As Range
    Dim xCellDate As Range
    Dim lastRow As Long
    Dim xMonth As Integer
    Dim xMonthName As String
    
    FPath = Application.ActiveWorkbook.Path
    
    For Each ws In ThisWorkbook.Sheets
        If Len(Dir(FPath & "\" & ws.Name, vbDirectory)) = 0 Then
            MkDir FPath & "\" & ws.Name
            
            ' 定位E列最后一行有数据的单元格
            lastRow = ws.Cells(ws.Rows.Count, "E").End(xlUp).Row
            ' 从E9开始到最后一行（如果lastRow<9，就取E9本身）
            Set xRgDate = ws.Range("E9:E" & IIf(lastRow >= 9, lastRow, 9))
            
            For Each xCellDate In xRgDate
                ' 先判断单元格是日期类型，再处理
                If IsDate(xCellDate.Value) Then
                    xMonth = Month(xCellDate.Value)
                    xMonthName = MonthName(xMonth)
                    ' 检查子文件夹是否存在，不存在则创建
                    If Len(Dir(FPath & "\" & ws.Name & "\" & xMonthName, vbDirectory)) = 0 Then
                        MkDir FPath & "\" & ws.Name & "\" & xMonthName
                    End If
                End If
            Next xCellDate
        Else
            MsgBox "文件夹已存在"
        End If
    Next ws
    
    MsgBox "文件夹创建完成"
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

关键改动说明： #

• 新增lastRow变量，用End(xlUp)定位E列最后一行有数据的单元格，彻底避免遍历整列的低效操作
• 用IsDate()替代Not IsEmpty()，确保只有日期值才进入后续处理，从根源解决类型不匹配问题
• 增加IIf判断，防止当E9以下没有数据时出现无效范围
• 统一声明所有变量（原代码里ws、xMonth等未声明，建议在模块开头加Option Explicit强制变量声明，减少隐性错误）

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