Question

目标是使用multiselect函数在同一工作表中依次加载多个纯文本文件。他们需要各自低于另一个。我管理代码一个接一个地正确加载它们，但我坚持使用MultiSelect。

代码确实附加了文件，但是一个接一个（换句话说是横向）而不是我需要的垂直文件。这是我的代码：

Private Sub Prova_Multiselect_Click()
    Dim Fitxers As Variant
    Dim Msg As String
    Dim I As Integer
    Dim destCell As Range

    Set destCell = Worksheets("PEDREC").Cells(Rows.Count, "A").End(xlUp).Offset(1)

    Fitxers = Application.GetOpenFilename(MultiSelect:=True, Title:="Choose txt files", FileFilter:="Text files *.txt (*.txt),")

    If IsArray(Fitxers) Then

        Set destCell = Worksheets("PEDREC").Cells(Rows.Count, "A").End(xlUp).Offset(1) 

        Msg = "Files selected:" & vbNewLine

        For I = LBound(Fitxers) To UBound(Fitxers)

            With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & Fitxers(I), Destination:=destCell)
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileCommaDelimiter = True
                .Refresh BackgroundQuery:=False
            End With

            Msg = Msg & Fitxers(I) & vbNewLine

        Next I

        MsgBox Msg

    Else
        MsgBox "No file selected."
    End If
End Sub

我找不到在同一列中附加所有文件的方法。

Answer 1

当你循环时，你根本没有推进destCell，而是永久地陷入了A2。尝试：

      For I = LBound(Fitxers) To UBound(Fitxers)


        With destCell.Parent.QueryTables.Add(Connection:="TEXT;" & Fitxers(I), Destination:=destCell)
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileCommaDelimiter = True
            .Refresh BackgroundQuery:=False
        End With

        Msg = Msg & Fitxers(I) & vbNewLine

        Set destCell = destCell.Offset(1, 0)


      Next I

使用Excel VBA使用Multiselect附加文本文件

1 个答案: