CSV交叉表转置导入Access表时遇下标越界错误求助

1. 下标越界错误的直接原因 #

标注行ReDim flds(rst.Fields.Count - 1 - 7)出现下标越界（Subscript out of range），是因为当CSV文件总列数≤7（无H列及后续列）时，rst.Fields.Count -1 -7的结果≤-1，而VBA不允许数组下界为负数，导致ReDim操作失败。

2. 分步修复代码 #

第一步：添加列数校验，避免无效数组定义 #

在ReDim前先判断CSV列数是否大于7，若不足则直接退出：

' 校验是否存在H列及后续数据列
If rst.Fields.Count <= 7 Then
    MsgBox "CSV文件无H列及后续数据列，无需处理"
    rst.Close
    Set rst = Nothing
    Exit Sub
End If

第二步：修正数组ReDim逻辑 #

确保数组下标从0开始，长度为后续列的实际数量：

ReDim flds(0 To rst.Fields.Count - 8) ' 总列数-7为后续列数量，下标范围0到(总列数-8)

替代原代码的ReDim flds(rst.Fields.Count -1 -7)，避免出现负数下标。

第三步：修正行定位错误 #

rst.Move 4会定位到第5行（Recordset初始为BOF，Move 1对应第1行），需改为定位到第4行：

rst.Move 3 ' 从BOF移动3次，定位到第4行（索引3）

第四步：修正CSV列名对应关系 #

CSV默认字段名为F1（A列）、F2（B列）…F8（H列），字段索引7对应F8，因此Where条件需修正为：

"Where F" & (fld + 8) & "=1 And [F1] Is Not Null" ' 加[F1]非空过滤前3行无效数据

第五步：优化行读取逻辑 #

原代码仅读取2行，改为读取第4行开始的所有行：

tbl = rst.GetRows(rst.RecordCount - rst.AbsolutePosition) ' 读取当前位置到末尾的所有行

3. 完整修复后的代码 #

Sub Import()
    Dim rst As New ADODB.Recordset
    Dim tbl() As Variant
    Dim fld As Integer
    Dim flds() As Variant
    
    rst.CursorLocation = adUseClient
    ' 打开CSV文件，获取全量字段与行数据（移除Top10避免字段数判断错误）
    rst.Open "SELECT * FROM [Text;Database=C:\dataimport\].quote.csv;", CurrentProject.Connection, adOpenStatic, adLockReadOnly
    
    ' 校验数据列数量
    If rst.Fields.Count <= 7 Then
        MsgBox "CSV文件无H列及后续数据列，无需处理"
        rst.Close
        Set rst = Nothing
        Exit Sub
    End If
    
    ' 定义后续列的字段索引数组
    ReDim flds(0 To rst.Fields.Count - 8)
    For fld = 0 To UBound(flds)
        flds(fld) = fld + 7 ' 索引7对应H列（F8）
    Next
    
    ' 定位到第4行
    rst.Move 3
    ' 读取目标列的所有有效行数据
    tbl = rst.GetRows(rst.RecordCount - rst.AbsolutePosition, , flds)
    rst.Close
    
    ' 循环插入符合条件的记录
    For fld = 0 To UBound(tbl, 1)
        CurrentDb.Execute _
        "Insert Into MiTabla (C1, C2, C3, C4, C5, C6, C7, C8, C9, C10) " & _
        "Select '" & Left(tbl(fld, 0), 8) & "', '" & Right(tbl(fld, 1), 2) & "', F1, F2, F3, F9, F11, F7, F8, F10 " & _
        "From [Text;Database=C:\dataimport\].quote.csv " & _
        "Where F" & (fld + 8) & "=1 And [F1] Is Not Null"
    Next
    
    Set rst = Nothing
    MsgBox "数据导入完成"
End Sub

4. 额外注意事项 #

• 确保CSV文件路径C:\dataimport\quote.csv存在，且Access具备读写权限；
• MiTabla表的字段类型需与插入数据匹配，避免类型转换错误；
• 若CSV前3行为表头，需在连接字符串中添加HDR=Yes，并将F1、F2等替换为实际表头字段名。

内容的提问来源于stack exchange，提问作者Jose Daniel Solis