为 Excel VBA 动态分配 CSV答案

【问题标题】：Dynamically Allocate CSV for Excel VBA为 Excel VBA 动态分配 CSV
【发布时间】：2021-11-17 04:00:40
【问题描述】：

我正在尝试为 Excel 创建一个宏，用户可以在其中导入 CSV。 CSV 的大小会有所不同。总会有 2 行，但列数的范围是 50-500 左右。我对 VBA 缺乏经验，并且正在努力克服错误 9 - 下标超出范围。我相信这是由带有 ReDim Preserve 功能的 For 循环引起的。由于我遇到了这个错误，我的下一个子程序没有执行。导入子例程基于我在网上找到的示例（主要是这个 - https://gist.github.com/gimbo/145d8527e7de823b7b537f4f34d216b3）。我曾尝试使用 Lbound 和 Ubound，但我的 csv 文件变量似乎不是这些函数的正确类型。我还考虑使用 For Each...Next 循环，但无法使其正常工作。在这一点上，我猜测错误是因为我在“i，j”数组中递增“i”，而 ReDim 指出在使用 Preserve 时只能递增“j”。也就是说，切换这些部分以尝试修复让我感到困惑，我也无法让它以这种方式工作。我很感激任何建议。

Sub ImportCSV()
    Dim column_types() As Variant
    csv_path = Application.GetOpenFilename()
    For i = 0 To 16384
        ReDim Preserve column_types(i)
        column_types(i) = 2
    Next i
    With ActiveWorkbook.Sheets(1).QueryTables.Add(Connection:="TEXT;" & csv_path, Destination:=Range("A1"))
        .Name = "importCSVimporter"
        .FieldNames = True
        .AdjustColumnWidth = True
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = column_types
        .Refresh BackgroundQuery:=False
    End With
    ActiveWorkbook.Sheets(1).QueryTables("importCSVimporter").Delete
End Sub
Sub TransposeRawData()
    Dim ColNumber As Long
    Dim ColLetter As String
    Dim OldRange As String
    Dim NewRange As String
    ColNumber = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    ColLetter = Split(Cells(1, ColNumber).Address, "$")(1)
    Let OldRange = "A1" & ":" & ColLetter & "2"
    Let NewRange = "A3" & ":" & "B" & ColNumber
    Sheets("QuestionnaireData").Range(NewRange).Value = WorksheetFunction.Transpose(Range(OldRange))
    Rows(2).EntireRow.Delete
    Rows(1).EntireRow.Delete
End Sub

【问题讨论】：

你到底想用For i = 0 To 16384、Redim Preserve column_types(i)做什么？
似乎你可以只 ReDim column_types(16384) 然后将它们分别设置为 2。这会更快，因为迭代执行 ReDim Preserve 效率不高。
旁注：Let 已弃用。
虽然我也没有看到任何明显的地方会抛出“下标超出范围”。您可能需要确定是哪一行引发了错误。除非你设置了Option Base 1，否则它可能会在i = 0 时抛出它。
Option Base 0 是默认值，它应该适合您。如果您还没有设置，请不要担心，这不是问题。

标签： excel vba

【解决方案1】：

搞定了

Sub ImportandTranspose()
ImportCSV
TransposeRawData
End Sub
Sub ImportCSV()
    Dim fileName As String
    fileName = Application.GetOpenFilename()
    ActiveCell.Range("A1").Select
    With ActiveSheet.QueryTables _
        .Add(Connection:="TEXT;" & folder & fileName, Destination:=Range("A1"))
        .FieldNames = True
        .AdjustColumnWidth = True
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub
Sub TransposeRawData()
    Dim ColNumber As Long
    Dim ColLetter As String
    Dim OldRange As String
    Dim NewRange As String
    ColNumber = Sheet1.Cells(1, Columns.Count).End(xlToLeft).Column
    ColLetter = Split(Cells(1, ColNumber).Address, "$")(1)
    Let OldRange = "A1" & ":" & ColLetter & "2"
    Let NewRange = "A3" & ":" & "B" & ColNumber
    Sheets("QuestionnaireData").Range(NewRange).Value = WorksheetFunction.Transpose(Range(OldRange))
    Rows(2).EntireRow.Delete
    Rows(1).EntireRow.Delete
End Sub

【讨论】：