VBA实现首9字符相同文件名同行排列时触发1004错误求助

原代码的核心问题 #

1. 取消判断逻辑冗余：TypeName(fnam) = "Boolean"时必然不是数组，无需额外判断Not (IsArray(fnam))，冗余逻辑可能引发判断失误
2. 分组逻辑完全错误：原代码未提取文件名前9个字符作为分组依据，反而错误和工作表D列单元格比较；当D列对应单元格为空时，Len(Cells(b+1,"D"))返回0，Mid(fnam(b), 1, 0)会触发参数非法的1004错误
3. 未声明变量：c未显式声明，隐式变体类型可能导致意外问题
4. 循环逻辑混乱：嵌套循环无意义遍历行，重复获取行列边界，导致无效操作

修正后的代码 #

Sub SelectFileName()
    Dim fnam As Variant
    Dim dict As Object
    Dim fileName As String
    Dim key As String
    Dim i As Integer, j As Integer
    Dim lastRow As Long
    
    ' 选择多个文件
    fnam = Application.GetOpenFileName("所有文件 (*.*), *.*", 1, _
        "选择要处理的文件", "确认选择", True)
    
    ' 用户取消选择则退出
    If TypeName(fnam) = "Boolean" Then Exit Sub
    
    ' 创建字典用于分组（键：文件名前9字符，值：同组文件名列表）
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 遍历所有选中的文件，按前9字符分组
    For i = 1 To UBound(fnam)
        fileName = CreateObject("Scripting.FileSystemObject").GetFileName(fnam(i))
        ' 提取前9个字符，不足9个则取全部
        key = Left(fileName, 9)
        ' 加入字典分组
        If dict.Exists(key) Then
            dict(key) = dict(key) & "|" & fileName
        Else
            dict(key) = fileName
        End If
    Next i
    
    ' 将分组结果写入工作表，同一组占一行
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row + 1 ' 从最后一行的下一行开始写
    For Each key In dict.keys
        ' 拆分同组文件名为数组，写入行
        Dim fileArr As Variant
        fileArr = Split(dict(key), "|")
        For j = 0 To UBound(fileArr)
            Cells(lastRow, j + 1).Value = fileArr(j)
        Next j
        lastRow = lastRow + 1
    Next key
    
    Set dict = Nothing
End Sub

代码说明 #

• 使用字典实现分组：以文件名前9个字符为键，自动归类相同前缀的文件名
• 兼容短文件名：文件名不足9个字符时，直接取完整文件名作为分组键
• 写入逻辑清晰：每组文件名写入同一行，从第一列开始依次填充，避免无效遍历
• 简化取消判断：直接检查fnam是否为布尔值即可退出

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