如何从多个txt文件导入数据

Question

我对 vba 还是很陌生，对数据导入有疑问。我有以下代码（如下）从文本文件导入和转置数据，但是能够突出显示 fx 五个文件然后导入它们会很好。我想我需要多选，但如何通过所有选定的文件将脚本设为运行？

希望你能帮到我

此致

朗尼

FILOPEN = Application.GetOpenFilename("Files (*.txt; *.jpg; *.bmp;   

*.tif),*.chr; *_chr.txt; *chr.txt; *.tif", _
 , "Select Picture to Import")
 On Error GoTo LastLine

Application.ScreenUpdating = False
    Workbooks.OpenText Filename:=FILOPEN, _
    Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
        Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _
        TrailingMinusNumbers:=True

'name of file that is imported from
Dim z As String

z = ActiveWorkbook.Name   
Windows(Left(z, Len(z))).Activate

'Copy Data
Range("c1").Select

    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy


Windows(Left(f, Len(f))).Activate 'name of file that is imported into (original sheet)

    ActiveCell.Offset(0, 1).Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True

    Selection.End(xlToLeft).Select
    ActiveCell.Offset(0, 0).Range("A1").Select

Answer 1

将 MultiSelect:=True 添加到 Application.GetOpenFilename 方法以 select 多个文件：

FILOPEN = Application.GetOpenFilename( _
FileFilter:="Files (*.txt; *.jpg; *.bmp; *.tif), *.chr; *_chr.txt; *chr.txt; *.tif", _
Title:="Select Picture to Import", _
MultiSelect:=True)

然后遍历结果数组：

If IsArray(FILOPEN) Then
    For I = LBound(FILOPEN) To UBound(FILOPEN)
        Workbooks.OpenText Filename:=FILOPEN(I) ...
        ...
        ...
        ...
    Next I
End If

Answer 2

下面的脚本将为您导入所有文本文件。当然，你可以select多个文件，就像陶丝雀演示的那样。如果要导入所有文件，运行下面的代码。

Sub Import_All_Text_Files_2007()

    Dim nxt_row As Long

     'Change Path
    Const strPath As String = "enter_your_path_here\"
    Dim strExtension As String

     'Stop Screen Flickering
    Application.ScreenUpdating = False

    ChDir strPath

     'Change extension
    strExtension = Dir(strPath & "*.txt")

    Do While strExtension <> ""

         'Adds File Name as title on next row
        Range("A65536").End(xlUp).Offset(1, 0).Value = strExtension

         'Sets Row Number for Data to Begin
        nxt_row = Range("A65536").End(xlUp).Offset(1, 0).Row

         'Below is from a recorded macro importing a text file
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & strPath & strExtension, Destination:=Range("$A$" & nxt_row))
            .Name = strExtension
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
             'Delimiter Settings:
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = True
            .TextFileOtherDelimiter = "="

            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

        strExtension = Dir
    Loop

    Application.ScreenUpdating = True

End Sub

如何从多个txt文件导入数据

How to import data from several txt files

excel

vba

multi-select