在同一個Excel中導入多個文本文件

Question

我正在Excel上運行一個宏來導入多個.txt文件，並將過濾器設置爲文件名，因此它的行爲就像通配符。每個文件都具有相同的佈局，分號由分號組成，有一個標題和11個柱。

宏工作正常，除了導入文件「並排」或「水平」。而不是導入下面的文件「下」（例如，第一個文件上行到第10行，然後下一個文件開始在第11行導入），它開始導入下一個colunm（第一個上升到「K」柱，下一個在colunm L上開始導入）。

我該如何解決？繼承人的代碼：

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 

Answer 1

添加一個檢查，如果Range("A1")是空的，所以它開始於A1如果A1是空的...

測試和工作：

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)) 

Answer 2

我沒有測試過，但好像更換：

Sub Importar_PORT(iFullFilePath As String, iFileNameWithoutExtension) 

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

與：

Sub Importar_PORT(iFullFilePath As String, iFileNameWithoutExtension) 

    afterLast = Cells(Rows.Count, 1).End(xlUp).Row + 1 

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

將做工精細。