将.txt中的数据附加到Excel工作表

时间:2020-02-10 16:48:36

标签: excel vba append

我有两个.txt文件。它们具有完全相同的格式和列。

第一个.txt文件如下所示:

enter image description here

这是我用来将数据从第一个.txt文件导出到Excel工作表(由@FaneDuru共享)的VBA代码

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工作表将如下所示:

enter image description here

但是我不确定如何将第二个.txt文件中的数据附加到现有电子表格中。

下面是我的第二个.txt文件。相同格式,相同列号,不同数据。

enter image description here

我想将第二个.txt文件中的数据追加到我的电子表格中,因此看起来像这样

enter image description here

如您所见,当我导入第二个.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文件中的标题行覆盖电子表格上现有数据的最后一行

我尝试在线查找,但没有找到与我在此处尝试的相似的内容,因此,任何评论将不胜感激!

1 个答案:

答案 0 :(得分: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