在我的Excel宏中,用户希望它创建结果的txt文件。我可以使用下面的代码来做到这一点。目前,创建带有110,000行的txt文件大约需要5分钟。恐怕用户会抱怨所花的时间。我想知道他们是否有更好/更快的方法来创建此txt文件?
预先感谢您的帮助。...
Sub Create_Text_File()
Application.ScreenUpdating = False
ThisBook = ""
ThisBook = ActiveWorkbook.Name
Worksheets("Results").Activate
r = 2
Dim X As Long
X = Cells.Find("*", [A1], , , xlByRows, xlPrevious).Row
If X > 1 Then
MyPath = ""
MyPath = ActiveWorkbook.Path
MyPath = MyPath & "\"
Load frmBank
frmBank.Show
On Error Resume Next
Dim efs As Object
Dim edump As Object
Dim eWriteString As String
Dim eRundate
eRundate = Year(Date)
If Len(Month(Date)) = 1 Then eRundate = eRundate & 0
eRundate = eRundate & Month(Date)
If Len(Day(Date)) = 1 Then eRundate = eRundate & 0
eRundate = eRundate & Day(Date)
If Len(Hour(Time)) = 1 Then eRundate = eRundate & 0
eRundate = eRundate & Hour(Time)
If Len(Minute(Time)) = 1 Then eRundate = eRundate & 0
eRundate = eRundate & Minute(Time)
If Len(Second(Time)) = 1 Then eRundate = eRundate & 0
eRundate = eRundate & Second(Time)
Randomize
eRandom = Int((99999 - 11111 + 1) * Rnd + 11111)
Set efs = CreateObject("Scripting.FileSystemObject")
MyFileName = MyPath & MyBank & " - " & eRundate & "-" & eRandom & ".txt"
Set edump = efs.createtextfile(MyFileName, False)
Do Until Len(Trim(Cells(r, 1))) + Len(Trim(Cells(r, 2))) + Len(Trim(Cells(r, 3))) = 0
eString = Chr(34) & Cells(r, 1) & Chr(34) & Chr(44) & Chr(34) & Cells(r, 2) & Chr(34) & Chr(44) & Chr(34) & Cells(r, 3) & Chr(34)
If Len(Trim(Cells((r + 1), 1))) > 0 Then
eString = eString & Chr(13) + Chr(10)
End If
eWriteString = eString
edump.Write eWriteString
r = r + 1
Loop
edump.Close
MsgBox " The txt file has been created.", vbExclamation, "Txt File Created"
Else
MsgBox " The txt file was not created as there is no data on the 'Results' sheet.", vbCritical, "Txt File Not Created"
End If
End Sub