xlsx에서 txt. 이 서브 루틴의 속도를 높이는 방법에 대한 팁?

Question

스프레드 시트의 각 시트를 txt 파일로 변환하는 코드가 있습니다.

코드가 잘 작동하지만,이 코드의 속도를 높이는 방법에 대한 조언을 구하고 싶습니다. 그러나 많은 양의 수출품 (abuot 90 txt 파일)이 제공됩니다. 당신의 도움에 미리

Sub xlsxTotxt() 

Dim i As Integer 
Dim directory As String 
Dim fname As String 
Dim xWs As Worksheet 
Dim xTextFile As String 
Dim rdate As String 

directory = ThisWorkbook.Sheets("Macro").Range("D576").Value 
rdate = ThisWorkbook.Sheets("Macro").Range("E47").Value 
i = 0 
Application.ScreenUpdating = False 
Application.DisplayAlerts = False 
Do While ThisWorkbook.Sheets("Macro").Range("D577").Offset(i).Value <> "" 
fname = Sheets("Macro").Range("D577").Offset(i).Value 
Workbooks.Open (directory & fname) 
For Each xWs In Workbooks(fname).Worksheets 
    xWs.Copy 
    xTextFile = directory & rdate & " - " & xWs.name & ".txt" 
    Application.ActiveWorkbook.SaveAs filename:=xTextFile, FileFormat:=xlText 
    Application.ActiveWorkbook.Saved = True 
    Application.ActiveWorkbook.Close 
Next 
Workbooks(fname).Close 
i = i + 1 
Loop 
Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

End Sub 

감사 :

이 내 코드입니다! 이것은 단지

지난

닫기 원본 통합 문서를 다시 텍스트로 선택 워크 시트를 저장 -

Answer 1

대신 각 시트

• 저장에서 ThisWorkbook
이
• 저장 통합 문서 텍스트로 각 워크 시트를 선택을 복사 텍스트 파일

 
Sub xlsxTotxt() 

    Dim i As Integer 
    Dim directory As String 
    Dim fname As String 
    Dim xWs As Worksheet 
    Dim xTextFile As String 
    Dim rdate As String 
    Dim ThisFullName As String 
    ThisFullName = ThisWorkbook.FullName 
    ThisWorkbook.Save 

    directory = ThisWorkbook.Sheets("Macro").Range("D576").value 
    rdate = ThisWorkbook.Sheets("Macro").Range("E47").value 
    i = 0 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Do While ThisWorkbook.Sheets("Macro").Range("D577").Offset(i).value "" 
     fname = Sheets("Macro").Range("D577").Offset(i).value 
     Workbooks.Open (directory & fname) 
     For Each xWs In Workbooks(fname).Worksheets 
      xWs.Select 
      xTextFile = directory & rdate & " - " & xWs.Name & ".txt" 
      ThisWorkbook.SaveAs Filename:=xTextFile, FileFormat:=xlText 
     Next 
     i = i + 1 
    Loop 
    Application.Workbooks.Open ThisFullName 
    ThisWorkbook.Close False 
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 

End Sub