VBA一维数组转二维数组时类型不兼容错误排查求助

错误原因分析 #

原代码触发类型不兼容错误，核心问题如下：

• arr2未初始化分配内存空间，直接赋值会触发类型错误
• 二维数组的列索引逻辑错误，应固定为0和1对应分割后的两部分，而非i和i+1
• Mid函数参数错误，分割后半部分时会包含"/"，需从arrSffx + 1开始截取
• 输出数据时误用原数组arr1，应使用目标数组arr2
• 变量声明不规范，部分变量未明确指定类型

修正后的代码 #

Sub Test2()
    Dim arr1 As Variant
    Dim arr2 As Variant
    Dim i As Long, arrSffx As Long, arrLen As Long
    Dim lastRow As Long
      
    ' 获取A列的唯一值一维数组
    arr1 = getUniqueValuesFromRange(Worksheets("table1").UsedRange.Columns("A"))
    
    ' 初始化二维数组：行数匹配原数组，列数固定为2
    ReDim arr2(0 To UBound(arr1), 0 To 1)
    
    For i = 0 To UBound(arr1)
        arrSffx = InStrRev(arr1(i), "/")
        arrLen = Len(arr1(i))
        
        If arrSffx > 0 Then ' 确保找到分隔符再执行分割
            ' 截取"/"之前的内容（不含"/"）
            arr2(i, 0) = Mid(arr1(i), 1, arrSffx - 1)
            ' 截取"/"之后的内容（不含"/"）
            arr2(i, 1) = Mid(arr1(i), arrSffx + 1, arrLen - arrSffx)
        Else
            ' 无"/"时，第一列存原内容，第二列留空
            arr2(i, 0) = arr1(i)
            arr2(i, 1) = ""
        End If
    Next i
    
    ' 批量将二维数组写入D、E列（从第2行开始）
    lastRow = UBound(arr2) + 2 ' 数组从0开始，对应行号需+2
    Worksheets("table1").Range("D2:E" & lastRow) = arr2
End Sub

关键修改说明 #

• 初始化arr2：用ReDim明确二维数组的行数和列数，分配内存空间
• 修正列索引：用arr2(i, 0)和arr2(i, 1)分别存储分割后的前后两部分
• 调整Mid参数：截取前半部分时长度设为arrSffx - 1（排除"/"），后半部分起始位置设为arrSffx + 1（跳过"/"）
• 批量写入数据：直接将整个二维数组写入单元格区域，比循环单单元格写入更高效
• 增加异常判断：处理数组元素无"/"的情况，避免运行报错

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