Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
speed up export to text
Hi
I am exporting the values from Excel to text file (CSV file). If the total number of rows are few thousands it's OK. But when I have about 50K records, it takes about 45 to 55 minutes. Is there a way to speed up this export process? Here is the code I am using (from Erlandsen consulting page) with some modifications Public Sub ExportToTextFile(FName As String, _ Sep As String, SelectionOnly As Boolean) Dim WholeLine As String Dim FNum As Integer Dim RowNdx As Long Dim ColNdx As Integer Dim StartRow As Long Dim EndRow As Long Dim StartCol As Integer Dim EndCol As Integer Dim CellValue As String Application.ScreenUpdating = False StopMacro = False On Error GoTo EndMacro: FNum = FreeFile If SelectionOnly = True Then With Selection StartRow = .Cells(1).Row + 1 StartCol = .Cells(1).Column EndRow = .Cells(.Cells.Count).Row EndCol = .Cells(.Cells.Count).Column End With Else With ActiveSheet.UsedRange StartRow = .Cells(1).Row + 1 StartCol = .Cells(1).Column EndRow = .Cells(.Cells.Count).Row EndCol = .Cells(.Cells.Count).Column End With End If Open FName For Output Access Write As #FNum For RowNdx = StartRow To EndRow WholeLine = "" For ColNdx = StartCol To EndCol ' the line below will replace a blank cell with spaces 'If Cells(RowNdx, ColNdx).Value = "" Then ' CellValue = Chr(34) & Chr(34) 'if you like blank fields to be skipped then use this 'if statement replacing the above if statement If Cells(RowNdx, ColNdx).Value = "" Then CellValue = "" Else CellValue = Cells(RowNdx, ColNdx).Text End If If CellValue < "" Then WholeLine = WholeLine & CellValue & Sep End If Next ColNdx Application.StatusBar = "Writing row # " & RowNdx & " to file" WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep)) Print #FNum, WholeLine Next RowNdx Application.ScreenUpdating = True Close #FNum Exit Sub EndMacro: 'On Error GoTo 0 StopMacro = True If Err.Number = 76 Then MsgBox "The path specified in the parmsheet does not exist. " & Chr(13) & _ "Please make sure a valid path is specified", vbExclamation Else MsgBox "Error encountered " & Err.Number & " - " & Err.Description End If Application.ScreenUpdating = True Close #FNum End Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
speed up export to text
Also it's killing the CPU - at 100 % (may be that's why it taking so long). Is there a better way to do this? Thanks Mohan "Mohan" wrote: Hi I am exporting the values from Excel to text file (CSV file). If the total number of rows are few thousands it's OK. But when I have about 50K records, it takes about 45 to 55 minutes. Is there a way to speed up this export process? Here is the code I am using (from Erlandsen consulting page) with some modifications Public Sub ExportToTextFile(FName As String, _ Sep As String, SelectionOnly As Boolean) Dim WholeLine As String Dim FNum As Integer Dim RowNdx As Long Dim ColNdx As Integer Dim StartRow As Long Dim EndRow As Long Dim StartCol As Integer Dim EndCol As Integer Dim CellValue As String Application.ScreenUpdating = False StopMacro = False On Error GoTo EndMacro: FNum = FreeFile If SelectionOnly = True Then With Selection StartRow = .Cells(1).Row + 1 StartCol = .Cells(1).Column EndRow = .Cells(.Cells.Count).Row EndCol = .Cells(.Cells.Count).Column End With Else With ActiveSheet.UsedRange StartRow = .Cells(1).Row + 1 StartCol = .Cells(1).Column EndRow = .Cells(.Cells.Count).Row EndCol = .Cells(.Cells.Count).Column End With End If Open FName For Output Access Write As #FNum For RowNdx = StartRow To EndRow WholeLine = "" For ColNdx = StartCol To EndCol ' the line below will replace a blank cell with spaces 'If Cells(RowNdx, ColNdx).Value = "" Then ' CellValue = Chr(34) & Chr(34) 'if you like blank fields to be skipped then use this 'if statement replacing the above if statement If Cells(RowNdx, ColNdx).Value = "" Then CellValue = "" Else CellValue = Cells(RowNdx, ColNdx).Text End If If CellValue < "" Then WholeLine = WholeLine & CellValue & Sep End If Next ColNdx Application.StatusBar = "Writing row # " & RowNdx & " to file" WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep)) Print #FNum, WholeLine Next RowNdx Application.ScreenUpdating = True Close #FNum Exit Sub EndMacro: 'On Error GoTo 0 StopMacro = True If Err.Number = 76 Then MsgBox "The path specified in the parmsheet does not exist. " & Chr(13) & _ "Please make sure a valid path is specified", vbExclamation Else MsgBox "Error encountered " & Err.Number & " - " & Err.Description End If Application.ScreenUpdating = True Close #FNum End Sub |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
speed up export to text
Grüezi Mohan
Mohan schrieb am 31.05.2006 I am exporting the values from Excel to text file (CSV file). If the total number of rows are few thousands it's OK. But when I have about 50K records, it takes about 45 to 55 minutes. Is there a way to speed up this export process? Maybe you'll be faster if you work with an array and write it to the .CSV in one step: Sub SaveCSV_a() Dim A As Variant Dim B() As String Dim D() As String Dim Z As Long Dim S As Byte Dim R As Long Dim C As Byte Const Path As String = "C:\Test\" Const Filename As String = "Test2" Const Extension As String = ".CSV" Const Separator As String = ";" Const Wrapper As String = """" 'Here you can define your own Range, too A = ActiveSheet.UsedRange If Not IsEmpty(A) Then Z = UBound(A, 1) S = UBound(A, 2) ReDim B(S - 1) ReDim D(Z - 1) For R = 1 To Z For C = 1 To S If InStr(1, A(R, C), Separator) 0 Then 'Rows whith cells including the Separator 'put in Wrapper B(C - 1) = Wrapper & A(R, C) & Wrapper Else B(C - 1) = A(R, C) End If Next C D(R - 1) = Join(B(), Separator) Next R Open Path & Filename & Extension For Output As #1 Print #1, "sep=" & Separator & vbCrLf & Join(D(), vbCrLf) Close #1 End If End Sub Regards Thomas Ramel -- - MVP for Microsoft-Excel - [Win XP Pro SP-2 / xl2000 SP-3] Microsoft Excel - Die ExpertenTipps: (http://tinyurl.com/9ov3l und http://tinyurl.com/cmned) |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
speed up export to text
Why not try using excel's built in functionality. Setup a template that
imports the sheet, uses formulas to accomplish the formatting (blank spaces to "") and then saves the sheet as a csv file. Example: Sub ExportXLData() Dim lngRows As Long 'Copy the data sheet into the template Workbooks("data.xls").Sheets("Data").Cells.Copy ThisWorkbook.Sheets("Data").Range("A1") 'Find number of rows lngRows = ThisWorkbook.Sheets("Data").Range("A65536").End(xl Up).Row - 1 'Template sheet contains formulas to change blank cells to "" 'Example of formula: =IF(Data!A2="","""""",Data!A2) With ThisWorkbook.Sheets("Template") 'Copy the formulas to all rows .Range("A2:E2").Copy .Range("A2", .Range("E2").Offset(lngRows, 0)).PasteSpecial xlPasteFormulas 'Copy this sheet to a new workbook .Copy End With 'Save and close the workbook With ActiveWorkbook Application.DisplayAlerts = False .SaveAs Filename:="C:\export.csv", FileFormat:=xlCSV, CreateBackup:=False .Close False End With End Sub "Mohan" wrote: Also it's killing the CPU - at 100 % (may be that's why it taking so long). Is there a better way to do this? Thanks Mohan "Mohan" wrote: Hi I am exporting the values from Excel to text file (CSV file). If the total number of rows are few thousands it's OK. But when I have about 50K records, it takes about 45 to 55 minutes. Is there a way to speed up this export process? Here is the code I am using (from Erlandsen consulting page) with some modifications Public Sub ExportToTextFile(FName As String, _ Sep As String, SelectionOnly As Boolean) Dim WholeLine As String Dim FNum As Integer Dim RowNdx As Long Dim ColNdx As Integer Dim StartRow As Long Dim EndRow As Long Dim StartCol As Integer Dim EndCol As Integer Dim CellValue As String Application.ScreenUpdating = False StopMacro = False On Error GoTo EndMacro: FNum = FreeFile If SelectionOnly = True Then With Selection StartRow = .Cells(1).Row + 1 StartCol = .Cells(1).Column EndRow = .Cells(.Cells.Count).Row EndCol = .Cells(.Cells.Count).Column End With Else With ActiveSheet.UsedRange StartRow = .Cells(1).Row + 1 StartCol = .Cells(1).Column EndRow = .Cells(.Cells.Count).Row EndCol = .Cells(.Cells.Count).Column End With End If Open FName For Output Access Write As #FNum For RowNdx = StartRow To EndRow WholeLine = "" For ColNdx = StartCol To EndCol ' the line below will replace a blank cell with spaces 'If Cells(RowNdx, ColNdx).Value = "" Then ' CellValue = Chr(34) & Chr(34) 'if you like blank fields to be skipped then use this 'if statement replacing the above if statement If Cells(RowNdx, ColNdx).Value = "" Then CellValue = "" Else CellValue = Cells(RowNdx, ColNdx).Text End If If CellValue < "" Then WholeLine = WholeLine & CellValue & Sep End If Next ColNdx Application.StatusBar = "Writing row # " & RowNdx & " to file" WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep)) Print #FNum, WholeLine Next RowNdx Application.ScreenUpdating = True Close #FNum Exit Sub EndMacro: 'On Error GoTo 0 StopMacro = True If Err.Number = 76 Then MsgBox "The path specified in the parmsheet does not exist. " & Chr(13) & _ "Please make sure a valid path is specified", vbExclamation Else MsgBox "Error encountered " & Err.Number & " - " & Err.Description End If Application.ScreenUpdating = True Close #FNum End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Export text | Excel Discussion (Misc queries) | |||
Speed button to wrap text | Excel Worksheet Functions | |||
How can I export text from excel autoshapes to a text file? | Excel Discussion (Misc queries) | |||
How to make text data export to excel in text format. | Excel Programming | |||
Export to CSV to speed up Loop | Excel Programming |