Добавление данных из .txt в таблицу Excel

Question

У меня есть два файла .txt. Они имеют точно такой же формат и столбцы.

Первый файл .txt выглядит следующим образом:

И это код VBA, который я использую для экспорта данных из первый файл .txt на листе Excel (общий доступ @FaneDuru)

Sub CopyLessColumns()
 Dim strSpec As String, i As Long, colToRet As Long
 Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long
 Dim fso As Object, txtStr As Object, strText As String

  Set fso = CreateObject("Scripting.FileSystemObject")
  strSpec = "C:\Users\xxxxxxxxx\Desktop\Input.txt"
  If Dir(strSpec) <> "" Then                   
    Set txtStr = fso.OpenTextFile(strSpec)
        strText = txtStr.ReadAll
    txtStr.Close
 End If

  arrSp = Split(strText, vbCrLf)
  colToRet = 5                             'Number of columns you need
  ReDim arrRez(UBound(arrSp), colToRet - 1)
  For i = 0 To UBound(arrSp)
    arrInt = Split(arrSp(i), vbTab)
    If UBound(arrInt) > colToRet - 1 Then
        For j = 0 To colToRet - 1
            arrRez(i, j) = arrInt(j)
        Next j
    End If
  Next i
  ActiveSheet.Range(Cells(1, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez
End Sub

После выполнения кода выше мой лист Excel будет выглядеть так:

Но я не уверен, как добавить данные из второго файла .txt в мою существующую электронную таблицу.

Ниже мой второй .txt файл. Одинаковый формат, одинаковые номера столбцов, просто разные данные.

Я хочу добавить данные из второго файла .txt в мою электронную таблицу, чтобы она выглядела так

Как вы можете видеть, когда я импортирую второй файл .txt, я хочу пропустить строку заголовка и напрямую импортировать данные ниже первой строки.

Кроме того, номер строки первого файла .txt может измениться в любое время, поэтому я не могу просто использовать точно такой же код и просто изменить последнюю строку с

ActiveSheet.Range(Cells(2, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez

на

ActiveSheet.Range(Cells(4, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez

Я также пытался найти последнюю строку, используя

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

Затем измените последнюю строку на

ActiveSheet.Range(Cells(lRow, 1), Cells(UBound(arrRez, 1) + 1, UBound(arrRez, 2) + 1)).Value = arrRez

Но это тоже не сработало , Он просто перезапишет последнюю строку существующих данных в таблице со строкой заголовка во втором файле .txt

Я пытался найти в Интернете, но не нашел ничего похожего на то, что я пытаюсь найти Делайте здесь, поэтому, любые комментарии будут оценены!

Answer 1

Пожалуйста, используйте эту версию кода! Это одинаково для всех текстовых файлов, которые вы хотите загрузить. Он будет загружать только заголовки таблиц (когда лист пуст), а затем только данные без заголовков:

Private Sub CopyLessColumns() 'it copies less columns than the txt file has
 Dim strSpec As String, i As Long, colToRet As Long, lastR As Long
 Dim arrSp As Variant, arrRez() As String, arrInt As Variant, j As Long, k As Long
 Dim fso As Object, txtStr As Object, strText As String 'no need of any reference

  Set fso = CreateObject("Scripting.FileSystemObject")
  strSpec = "C:\Teste VBA Excel\TextFileTabDel.txt"
  If Dir(strSpec) <> "" Then 'check if file exists
    Set txtStr = fso.OpenTextFile(strSpec)
        strText = txtStr.ReadAll
    txtStr.Close
  End If
  arrSp = Split(strText, vbCrLf)

    colToRet = 5 'Number of columns to be returned
    lastR = ActiveSheet.Range("A" & Rows.count).End(xlUp).Row 'last row in A:A
    'arrRez is dimensioned from 0 to UBound(arrSp) only for lastR = 1
    ReDim arrRez(IIf(lastR = 1, 0, 1) To UBound(arrSp), colToRet - 1)
    For i = IIf(lastR = 1, 0, 1) To UBound(arrSp) 'Only in case of larR = 1, the
                                                  'head of the table is load in arr
      arrInt = Split(arrSp(i), vbTab)  'each strText line is split in an array
      If UBound(arrInt) > colToRet - 1 Then
          For j = 0 To colToRet - 1
              arrRez(i, j) = arrInt(j) 'each array element is loaded in the arrRez
          Next j
      End If
    Next i
    'The array is dropped in the dedicated range (calculated using Resize):
    ActiveSheet.Range("A" & IIf(lastR = 1, lastR, lastR + 1)).Resize(UBound(arrRez, 1), _
                                                UBound(arrRez, 2) + 1).Value = arrRez
End Sub