在同一Excel表单中导入多个文本文件 [英] Import Multiple Text Files in the same excel Sheet

问题描述

我在Excel上运行一个宏以导入多个.txt文件，并将一个过滤器设置为文件名，因此它的行为就像一个通配符。每个文件具有相同的布局，分号分隔，有一个标题和11个colunms。

宏可以正常工作，除了导入文件并排或水平。而不是导入下一个文件under（例如，第一个文件上升到第10行，然后下一个文件开始在第11行导入），它将在下一个colunm中开始导入（第一个文件上升到colunmK下一个开始导入colunm L）。

我该如何解决？代理代码：

  Sub Abrir_PORT（）
 
 Dim Caminho As String 
 Caminho =表单（DADOS）。单元格（5，5）.Value 
表格（PORT）。选择
 
 Dim FS 
设置FS = CreateObject（Scripting.FileSystemObject ）
 
 Dim Filter As String：Filter =ATENTO_TLMKT_REC * .txt
 Dim dirTmp As String 
 
如果FS.FolderExists（Caminho）Then 
 dirTmp = Dir（Caminho&\& Filter）
 Do While Len（dirTmp）> 0 
 Call Importar_PORT（Caminho&\& dirTmp，_ 
 Left（dirTmp，InStrRev（dirTmp，。） -  1））
 dirTmp = Dir 
 Loop 
 End If 
 
 End Sub 
 
 Sub Importar_PORT（iFullFilePath As String，iFileNameWithoutExtension）
 
 With ActiveSheet.QueryTables.Add连接：= _ 
TEXT;& iFullFilePath，_ 
目标：=范围（$ A $ 1））
 .Name = iFileNameWithoutExtension 
 .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 
 .TextFileConsecutiveDelimiter = False 
 .TextFileTabDelimiter = False 
 .TextFileSemicolonDelimiter = True 
 .TextFileCommaDelimiter = False 
 .TextFileSpaceDelimiter = False 
 .TextFileColumnDataTypes = Array（1，1，1，1，1，1，1，1）
 .TextFileTrailingMinusNumbers = True 
 .Refresh BackgroundQuery：= False 
 
 iRow = 2 
 
执行表单（PORT）。单元格（iRow，1）< 
 
如果Cells（iRow，2）= IsNumber Then 
 
 Else 
 
 Rows（iRow）.Select 
 Selection.EntireRow 。删除
 
 iRow = iRow  -  1 
 contagem = contagem + 1 
 
如果
 
 iRow = iRow + 1 
 
循环
 
结束
 
结束子
  

解决方案

如果 Range（A1）是空的，则添加检查，所以它从 A1 如果 A1 是空的...



测试和工作：

  Sub Importar_PORT（iFullFilePath As String，iFileNameWithoutExtension）
 
 Dim lngStartRow As Long 
使用ActiveSheet 
如果.Range（A1）=然后
 lngStartRow = 1 
 Else 
 lngStartRow = .Range（A& .Rows.Count ）.End（xlUp）.row + 1 
 End If 
 En d With 
 
 With ActiveSheet.QueryTables.Add（Connection：= _ 
TEXT;& iFullFilePath，_ 
目的地：=范围（$ A $& lngStartRow））
  

I'm running a Macro on Excel to import multiple .txt files and with a filter set to the filename, so it acts like a wildcard. Every file has the same layout, it's Semicolon delimited, has a header and 11 colunms.

The macro works fine, except its importing the files "Side by Side" or "horizontally". Instead of import the next file "under" (like, the first file goes up to the row 10, then next one start importing at row 11), it start importing in the next colunm (the first goes up the colunm "K", the next one start importing on colunm L).

How can I fix it? Heres the code:

Sub Abrir_PORT()

    Dim Caminho As String
    Caminho = Sheets("DADOS").Cells(5, 5).Value
    Sheets("PORT").Select

    Dim FS
    Set FS = CreateObject("Scripting.FileSystemObject")

    Dim Filter As String: Filter = "ATENTO_TLMKT_REC*.txt"
    Dim dirTmp As String

    If FS.FolderExists(Caminho) Then
        dirTmp = Dir(Caminho & "\" & Filter)
        Do While Len(dirTmp) > 0
            Call Importar_PORT(Caminho & "\" & dirTmp, _
                            Left(dirTmp, InStrRev(dirTmp, ".") - 1))
            dirTmp = Dir
        Loop
    End If

End Sub

Sub Importar_PORT(iFullFilePath As String, iFileNameWithoutExtension)

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & iFullFilePath, _
        Destination:=Range("$A$1"))
        .Name = iFileNameWithoutExtension
        .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
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False

    iRow = 2

    Do While Sheets("PORT").Cells(iRow, 1) <> ""

                If Cells(iRow, 2) = IsNumber Then

                Else

                Rows(iRow).Select
                Selection.EntireRow.Delete

                iRow = iRow - 1
                contagem = contagem + 1

                End If

 iRow = iRow + 1

 Loop

    End With

End Sub

解决方案

Adding a check if Range("A1") is empty so it starts at A1 if A1 is empty...

Tested and working:

Sub Importar_PORT(iFullFilePath As String, iFileNameWithoutExtension)

    Dim lngStartRow As Long
    With ActiveSheet
        If .Range("A1") = "" Then
            lngStartRow = 1
        Else
            lngStartRow = .Range("A" & .Rows.Count).End(xlUp).row + 1
        End If
    End With

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & iFullFilePath, _
        Destination:=Range("$A$" & lngStartRow))

这篇关于在同一Excel表单中导入多个文本文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！