避免循環，而使用excel記事本

我使用下面的代碼來複制一些範圍從Excel到記事本，但它非常緩慢，當我工作超過10萬（100,000）的數據。有沒有更簡單的方法來實現這一點，而不使用發送鍵方法。避免循環，而使用excel記事本

Sub PrintToTextFile() 

Dim FileNum As Integer, cl As Range, z As Integer, y As Integer 

Dim myStr As String 

FileNum = FreeFile ' next free filenumber 

'Open "C:\Temp\TEXTFILE.TXT" For Output As #FileNum ' creates the new file 

Open "C:\temp\TEXTFILE.TXT" For Append As #FileNum 

Print #FileNum, [a1] 

z = 10 

For Each cl In [b1:b123400] 

    y = cl.Row 

    If y = z Then 

     myStr = myStr & "|" & cl 

     'appends the input to an existing file write to the textfile 

    Else: Print #FileNum, myStr 

     z = cl.Row 

     myStr = "": myStr = myStr & "|" & cl 

    End If 

Next 

'appends the input to an existing file write to the textfile 

Print #FileNum, myStr 

Close #FileNum ' close the file 

End Sub

來源

2014-04-01 user3114645

的可能重複[如何創建並寫入使用VBA一個txt文件（http://stackoverflow.com/questions/11503174/how-to-create-and-write-to-a-txt -file-using-vba） –

試試建議[這裏]（http://stackoverflow.com/questions/11503174/how-to-create-and-write-to-a-txt-file-using-vba）使用FSO和WriteLine方法（仍然在循環中，但我認爲應該更快）。 –

嘗試和經測試（1.5萬盧比，即15萬行） - 拍攝時間1秒

這應該會更快，因爲它通過細胞不循環，並在同一寫入文件時間。它使用數組。

Sub PrintToTextFile() 
    Dim ws As Worksheet 
    Dim FileNum As Integer, z As Long, y As Long, i As Long 
    Dim myStr As String 
    Dim Myar, ArOutput() As String 

    '~~> Set this to the relevant sheet 
    Set ws = ThisWorkbook.Sheets("Sheet1") 

    Myar = ws.Range("b1:b123400").Value 

    FileNum = FreeFile ' next free filenumber 

    Open "C:\temp\TEXTFILE.TXT" For Append As #FileNum 

    Print #FileNum, ws.Range("A1").Value 

    z = 10 

    For i = LBound(Myar) To UBound(Myar) 
     If i = z Then 
      myStr = myStr & "|" & Myar(i, 1) 
     Else 
      ReDim Preserve ArOutput(y) 
      ArOutput(y) = myStr 
      y = y + 1 
      z = i 
      myStr = "": myStr = myStr & "|" & Myar(i, 1) 
     End If 
    Next i 

    For i = LBound(ArOutput) To UBound(ArOutput) 
     Print #FileNum, ArOutput(i) 
    Next i 

    'appends the input to an existing file write to the textfile 
    Print #FileNum, myStr 
    Close #FileNum ' close the file 
End Sub

截圖

enter image description here

代碼用於上面測試。

Sub PrintToTextFile() 
    Dim ws As Worksheet 
    Dim FileNum As Integer, z As Long, y As Long, i As Long 
    Dim myStr As String 
    Dim Myar, ArOutput() As String 

    Debug.Print "Process Started at " & Now 

    '~~> Set this to the relevant sheet 
    Set ws = ThisWorkbook.Sheets("Sheet1") 

    Myar = ws.Range("B1:B150000").Value 

    FileNum = FreeFile ' next free filenumber 

    Open "C:\temp1\TEXTFILE.TXT" For Output As #FileNum 

    Print #FileNum, ws.Range("A1").Value 

    z = 10 

    For i = LBound(Myar) To UBound(Myar) 
     If i = z Then 
      myStr = myStr & "|" & Myar(i, 1) 
     Else 
      ReDim Preserve ArOutput(y) 
      ArOutput(y) = myStr 
      y = y + 1 
      z = i 
      myStr = "": myStr = myStr & "|" & Myar(i, 1) 
     End If 
    Next i 

    For i = LBound(ArOutput) To UBound(ArOutput) 
     Print #FileNum, ArOutput(i) 
    Next i 

    'appends the input to an existing file write to the textfile 
    Print #FileNum, myStr 
    Close #FileNum ' close the file 

    Debug.Print "Process ended at " & Now 
End Sub

來源

2014-04-01 18:10:58

真棒..你讓我的日子:)：D。 – user3114645

避免循環，而使用excel記事本

回答

相關問題