我建议使用数组来执行整个操作,而不是使用 Excel 来做这些脏活。下面的代码采取了1 sec
处理 300 个文件
LOGIC:
- 循环遍历包含文本文件的目录
- 打开文件并将其一次性读取到数组中,然后关闭文件。
- 将结果存储在临时数组中
- 当所有数据读取完毕后,只需将数组输出到Excel Sheet
代码:(经过尝试和测试)
'~~> Change path here
Const sPath As String = "C:\Users\Siddharth Rout\Desktop\DeleteMelater\"
Sub Sample()
Dim wb As Workbook
Dim ws As Worksheet
Dim MyData As String, tmpData() As String, strData() As String
Dim strFileName As String
'~~> Your requirement is of 267 files of 1 line each but I created
'~~> an array big enough to to handle 1000 files
Dim ResultArray(1000, 3) As String
Dim i As Long, n As Long
Debug.Print "Process Started At : " & Now
n = 1
Set wb = ThisWorkbook
'~~> Change this to the relevant sheet
Set ws = wb.Sheets("Sheet1")
strFileName = Dir(sPath & "\*.txt")
'~~> Loop through folder to get the text files
Do While Len(strFileName) > 0
'~~> open the file in one go and read it into an array
Open sPath & "\" & strFileName For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
'~~> Collect the info in result array
For i = LBound(strData) To UBound(strData)
If Len(Trim(strData(i))) <> 0 Then
tmpData = Split(strData(i), ",")
ResultArray(n, 0) = Replace(tmpData(0), Chr(34), "")
ResultArray(n, 1) = Replace(tmpData(1), Chr(34), "")
ResultArray(n, 2) = Replace(tmpData(2), Chr(34), "")
ResultArray(n, 3) = Replace(tmpData(3), Chr(34), "")
n = n + 1
End If
Next i
'~~> Get next file
strFileName = Dir
Loop
'~~> Write the array to the Excel Sheet
ws.Range("A1").Resize(UBound(ResultArray), _
UBound(Application.Transpose(ResultArray))) = ResultArray
Debug.Print "Process ended At : " & Now
End Sub