从.txt文件读取文本到不同的工作表excel

我从其他地方采取了这个代码，因为我不知道如何编写代码…我只需要帮助如何使这个文件打印到工作簿中的不同的工作表，可以说工作表3，目前它只是打印在工作表1.我知道它可能很简单，但我已经尝试过了一个多小时，并且一直在收到错误。

Private Sub ReadTxtFiles() 'Dim start As Date 'start = Now Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") Dim oFS As Object '''''Assign the Workbook File Name along with its Path '''''Change path of the Target File name Dim v As Variant, filepath As String For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants) filepath = v.Value Debug.Print filepath Dim arr(100000) As String Dim i As Long i = 0 If oFSO.FileExists(filepath) Then On Error GoTo Err Set oFS = oFSO.OpenTextFile(filepath) Do While Not oFS.AtEndOfStream arr(i) = oFS.ReadLine i = i + 1 Loop oFS.Close Else MsgBox "The file path is invalid.", vbCritical, vbNullString Exit Sub End If For i = LBound(arr) To UBound(arr) If InStr(1, arr(i), ThisWorkbook.Sheets(1).Range("A20").Value, vbTextCompare) Then 'While value in 'ThisWorkbook.Sheets(1).Range("A20").Value' has not been found, 'keep looping to print out contents starting from 'ThisWorkbook.Sheets(1).Range("A21").Value' Do While InStr(1, arr(i), ThisWorkbook.Sheets(1).Range("A21").Value, vbTextCompare) = 0 Debug.Print i + 1, Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) 'increment count i = i + 1 Loop 'Print out the 'ThisWorkbook.Sheets(1).Range("A21").Value' line as well Debug.Print i + 1, arr(i) Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) Exit For End If Next Next Debug.Print DateDiff("s", start, Now) Exit Sub Err: MsgBox "Error while reading the file.", vbCritical, vbNullString oFS.Close Exit Sub End Sub 

Answer 1

替代：

 For i = LBound(arr) To UBound(arr) If InStr(1, arr(i), ThisWorkbook.Sheets(1).Range("A20").Value, vbTextCompare) Then 'While value in 'ThisWorkbook.Sheets(1).Range("A20").Value' has not been found, 'keep looping to print out contents starting from 'ThisWorkbook.Sheets(1).Range("A21").Value' Do While InStr(1, arr(i), ThisWorkbook.Sheets(1).Range("A21").Value, vbTextCompare) = 0 Debug.Print i + 1, Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) 'increment count i = i + 1 Loop 'Print out the 'ThisWorkbook.Sheets(1).Range("A21").Value' line as well Debug.Print i + 1, arr(i) Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) Exit For End If Next 

有：

  Dim sheet1A20 As String Dim sheet1A21 As String With ThisWorkbook sheet1A20 = .Sheets(1).Range("A20").Value sheet1A21 = .Sheets(1).Range("A21").Value With .Sheets(3) For i = LBound(arr) To UBound(arr) If InStr(1, arr(i), sheet1A20, vbTextCompare) = 0 Then 'While value in 'ThisWorkbook.Sheets(1).Range("A20").Value' has not been found, 'keep looping to print out contents starting from 'ThisWorkbook.Sheets(1).Range("A21").Value' Do While InStr(1, arr(i), sheet1A21, vbTextCompare) = 0 Debug.Print i + 1 .Cells(.Rows.count, 1).End(xlUp).Offset(1).Resize(, 2) = Array(i + 1, arr(i)) i = i + 1 'increment count Loop 'Print out the 'ThisWorkbook.Sheets(1).Range("A21").Value' line as well Debug.Print i + 1, arr(i) .Cells(.Rows.count, 1).End(xlUp).Offset(1).Resize(, 2) = Array(i + 1, arr(i)) Exit For End If Next End With End With 

Answer 2

当我广泛地看你的脚本在这里做什么。 要简单地改变输出表，应该是这样的。

 Private Sub ReadTxtFiles() 'Dim start As Date 'start = Now Dim oFSO As Object Set oFSO = CreateObject("Scripting.FileSystemObject") Dim oFS As Object '''''Assign the Workbook File Name along with its Path '''''Change path of the Target File name Dim v As Variant, filepath As String For Each v In Worksheets("Sheet2").Columns("B").SpecialCells(xlCellTypeConstants) filepath = v.Value Debug.Print filepath Dim arr(100000) As String Dim i As Long i = 0 If oFSO.FileExists(filepath) Then On Error GoTo Err Set oFS = oFSO.OpenTextFile(filepath) Do While Not oFS.AtEndOfStream arr(i) = oFS.ReadLine i = i + 1 Loop oFS.Close Else MsgBox "The file path is invalid.", vbCritical, vbNullString Exit Sub End If For i = LBound(arr) To UBound(arr) If InStr(1, arr(i), ThisWorkbook.Sheets(1).Range("A20").Value, vbTextCompare) Then 'While value in 'ThisWorkbook.Sheets(1).Range("A20").Value' has not been found, 'keep looping to print out contents starting from 'ThisWorkbook.Sheets(1).Range("A21").Value' Do While InStr(1, arr(i), ThisWorkbook.Sheets(1).Range("A21").Value, vbTextCompare) = 0 Debug.Print i + 1, '################### '# Added the sheet name to the front of this variable. '# Make sure there is a third sheet in your workbook! '################## sheets("Sheet3").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 sheets("Sheet3").Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) 'increment count i = i + 1 Loop '################### '# Also added the sheet name here '################## 'Print out the 'ThisWorkbook.Sheets(1).Range("A21").Value' line as well Debug.Print i + 1, arr(i) sheets("Sheet3").Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1) = i + 1 sheets("Sheet3").Range("B" & Range("B" & Rows.Count).End(xlUp).Row + 1) = arr(i) Exit For End If Next Next Debug.Print DateDiff("s", start, Now) Exit Sub Err: MsgBox "Error while reading the file.", vbCritical, vbNullString oFS.Close Exit Sub End Sub