使用VBA将Excel数据保存为csv - 删除文件末尾的空行以进行保存

时间:2021-10-03 21:45:42

I am creating a set of csv files in VBA.

我在VBA中创建了一组csv文件。

My script is creating the data set I need, but the number of rows differs in multiple iterations of the loop. For instance, for i=2, I have 100,000 rows, but for i=3, I have 22,000 rows. The problem is that when Excel saves these separate csv files, it does not truncate the space at the end. This leaves 78,000 blank rows at the end of the file, which is an issue given that I need about 2,000 files to be generated, each several megabytes large. (I have some data I need in SQL, but can't do the math in SQL itself. Long story.)

我的脚本正在创建我需要的数据集,但行数在循环的多次迭代中有所不同。例如,对于i = 2,我有100,000行,但对于i = 3,我有22,000行。问题是,当Excel保存这些单独的csv文件时,它不会截断末尾的空格。这会在文件末尾留下78,000个空行,这是一个问题,因为我需要生成大约2,000个文件,每个文件大几兆字节。 (我在SQL中需要一些数据,但不能在SQL本身做数学。很长的故事。)

This problem normally occurs when saving manually - you need to close the file after removing the rows, then reopen, which is not an option in this case, since it's happening automatically in VBA. Removing the blank rows after saving using a script in another language isn't really an option, since I actually need the output files to fit on the drive available, and they are unnecessarily huge now.

手动保存时通常会出现此问题 - 您需要在删除行后关闭文件,然后重新打开,这在这种情况下不是一个选项,因为它在VBA中自动发生。使用另一种语言的脚本保存后删除空白行并不是一个真正的选择,因为我实际上需要输出文件适合可用的驱动器,而且它们现在不必要地巨大。

I have tried Sheets(1).Range("A2:F1000001").ClearContents, but this does not truncate anything. Removing the rows should have similarly no effect before saving, since Excel saves all rows until the end of the file, as it stores the bottom-right most cell operated on. Is there a way to have excel save only the rows I need?

我试过Sheets(1).Range(“A2:F1000001”)。ClearContents,但这并没有截断任何东西。在保存之前删除行应该具有类似的效果,因为Excel将所有行保存到文件末尾,因为它存储了最右下角的单元格。有没有办法让excel只保存我需要的行?

Here is my code used to save: (The truncation happens earlier, in the routing that calls this one)

这是我用来保存的代码:(截断发生得更早,在调用这个的路由中)

Sub SaveCSV()
'Save the file as a CSV...
  Dim OutputFile As Variant
  Dim FilePath As Variant

  OutputPath = ActiveWorkbook.Worksheets("Macro").Range("B2").Value
  OutputFile = OutputPath & ActiveWorkbook.Worksheets("Macro").Range("B1").Value
  Application.DisplayAlerts = False 'DISABLE ALERT on Save - overwrite, etc.
  ActiveWorkbook.SaveAs Filename:=OutputFile, FileFormat:=xlCSV, CreateBackup:=False
  Application.DisplayAlerts = True 'DISPLAY ALERTS
End Sub

The relevant bit of code is here:

相关的代码位在这里:

'While looping through Al, inside of looping through A and B...
'Created output values needed in this case, in an array...

Sheets(1).Range("A2:E90001") = Output

ActiveWorkbook.Worksheets(1).Range("F2").Formula = "=(does not matter, some formula)"
ActiveWorkbook.Worksheets(1).Range("F2").AutoFill Destination:=Range("F2:F90001")

'Set Filename to save into...
ActiveWorkbook.Worksheets("Macro").Range("B1").Value = "Values_AP" & Format(A, "#") & "_BP" & Format(B, "#") & "_Al" & Format(Al, "#")

'Save Sheet and reset...
Call SaveCSV
Sheets(1).Range("A2:F90001").ClearContents
CurrRow = 1

Next Al

2 个解决方案

#1


2  

You can get the UsedRange to recalculate itself without deleting columns and rows with a simple

您可以让UsedRange重新计算自己而不用简单的删除列和行

ActiveSheet.UsedRange

Alternatively you can automate the manual removal of the "false" usedrange by deleting the areas below the last used cell with code such as DRJ's VBAexpress article, or by using an addin such as ASAP Utilities

或者,您可以通过使用DRJ的VBAexpress文章等代码删除上一个使用过的单元格下方的区域,或者使用ASAP Utilities等插件,自动手动删除“false”usedrange。

The function from DRJ's article is;

DRJ的文章的功能是;

Option Explicit 

Sub ExcelDiet() 

Dim j               As Long 
Dim k               As Long 
Dim LastRow         As Long 
Dim LastCol         As Long 
Dim ColFormula      As Range 
Dim RowFormula      As Range 
Dim ColValue        As Range 
Dim RowValue        As Range 
Dim Shp             As Shape 
Dim ws              As Worksheet 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

On Error Resume Next 

For Each ws In Worksheets 
    With ws 
         'Find the last used cell with a formula and value
         'Search by Columns and Rows
        On Error Resume Next 
        Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ 
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) 
        Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ 
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) 
        Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ 
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) 
        Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ 
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) 
        On Error GoTo 0 

         'Determine the last column
        If ColFormula Is Nothing Then 
            LastCol = 0 
        Else 
            LastCol = ColFormula.Column 
        End If 
        If Not ColValue Is Nothing Then 
            LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column) 
        End If 

         'Determine the last row
        If RowFormula Is Nothing Then 
            LastRow = 0 
        Else 
            LastRow = RowFormula.Row 
        End If 
        If Not RowValue Is Nothing Then 
            LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row) 
        End If 

         'Determine if any shapes are beyond the last row and last column
        For Each Shp In .Shapes 
            j = 0 
            k = 0 
            On Error Resume Next 
            j = Shp.TopLeftCell.Row 
            k = Shp.TopLeftCell.Column 
            On Error GoTo 0 
            If j > 0 And k > 0 Then 
                Do Until .Cells(j, k).Top > Shp.Top + Shp.Height 
                    j = j + 1 
                Loop 
                If j > LastRow Then 
                    LastRow = j 
                End If 
                Do Until .Cells(j, k).Left > Shp.Left + Shp.Width 
                    k = k + 1 
                Loop 
                If k > LastCol Then 
                    LastCol = k 
                End If 
            End If 
        Next 

        .Range(.Cells(1, LastCol + 1), .Cells(.Rows.Count, .Columns.Count)).EntireColumn.Delete 
        .Range("A" & LastRow + 1 & ":A" & .Rows.Count).EntireRow.Delete 
    End With 
Next 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

End Sub 

#2


2  

Excel saves the UsedRange. In order to truncate the UsedRange, you need to delete whole rows and save the file.

Excel保存UsedRange。要截断UsedRange,您需要删除整行并保存文件。

If that's not an option, insert a new worksheet, copy the prepared data to it (thus leaving its UsedRange matching actual data), use Worksheet.SaveAs (as opposed to Workbook.SaveAs) and delete the worksheet.

如果这不是一个选项,插入一个新的工作表,将准备好的数据复制到它(从而使其UsedRange与实际数据匹配),使用Worksheet.SaveAs(而不是Workbook.SaveAs)并删除工作表。

Although the actual problem here is why your UsedRange gets that big in the first place.

虽然这里的实际问题是你的UsedRange首先获得如此大的原因。

#1


2  

You can get the UsedRange to recalculate itself without deleting columns and rows with a simple

您可以让UsedRange重新计算自己而不用简单的删除列和行

ActiveSheet.UsedRange

Alternatively you can automate the manual removal of the "false" usedrange by deleting the areas below the last used cell with code such as DRJ's VBAexpress article, or by using an addin such as ASAP Utilities

或者,您可以通过使用DRJ的VBAexpress文章等代码删除上一个使用过的单元格下方的区域,或者使用ASAP Utilities等插件,自动手动删除“false”usedrange。

The function from DRJ's article is;

DRJ的文章的功能是;

Option Explicit 

Sub ExcelDiet() 

Dim j               As Long 
Dim k               As Long 
Dim LastRow         As Long 
Dim LastCol         As Long 
Dim ColFormula      As Range 
Dim RowFormula      As Range 
Dim ColValue        As Range 
Dim RowValue        As Range 
Dim Shp             As Shape 
Dim ws              As Worksheet 

Application.ScreenUpdating = False 
Application.DisplayAlerts = False 

On Error Resume Next 

For Each ws In Worksheets 
    With ws 
         'Find the last used cell with a formula and value
         'Search by Columns and Rows
        On Error Resume Next 
        Set ColFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ 
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) 
        Set ColValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ 
        LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious) 
        Set RowFormula = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlFormulas, _ 
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) 
        Set RowValue = .Cells.Find(What:="*", After:=Range("A1"), LookIn:=xlValues, _ 
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious) 
        On Error GoTo 0 

         'Determine the last column
        If ColFormula Is Nothing Then 
            LastCol = 0 
        Else 
            LastCol = ColFormula.Column 
        End If 
        If Not ColValue Is Nothing Then 
            LastCol = Application.WorksheetFunction.Max(LastCol, ColValue.Column) 
        End If 

         'Determine the last row
        If RowFormula Is Nothing Then 
            LastRow = 0 
        Else 
            LastRow = RowFormula.Row 
        End If 
        If Not RowValue Is Nothing Then 
            LastRow = Application.WorksheetFunction.Max(LastRow, RowValue.Row) 
        End If 

         'Determine if any shapes are beyond the last row and last column
        For Each Shp In .Shapes 
            j = 0 
            k = 0 
            On Error Resume Next 
            j = Shp.TopLeftCell.Row 
            k = Shp.TopLeftCell.Column 
            On Error GoTo 0 
            If j > 0 And k > 0 Then 
                Do Until .Cells(j, k).Top > Shp.Top + Shp.Height 
                    j = j + 1 
                Loop 
                If j > LastRow Then 
                    LastRow = j 
                End If 
                Do Until .Cells(j, k).Left > Shp.Left + Shp.Width 
                    k = k + 1 
                Loop 
                If k > LastCol Then 
                    LastCol = k 
                End If 
            End If 
        Next 

        .Range(.Cells(1, LastCol + 1), .Cells(.Rows.Count, .Columns.Count)).EntireColumn.Delete 
        .Range("A" & LastRow + 1 & ":A" & .Rows.Count).EntireRow.Delete 
    End With 
Next 

Application.ScreenUpdating = True 
Application.DisplayAlerts = True 

End Sub 

#2


2  

Excel saves the UsedRange. In order to truncate the UsedRange, you need to delete whole rows and save the file.

Excel保存UsedRange。要截断UsedRange,您需要删除整行并保存文件。

If that's not an option, insert a new worksheet, copy the prepared data to it (thus leaving its UsedRange matching actual data), use Worksheet.SaveAs (as opposed to Workbook.SaveAs) and delete the worksheet.

如果这不是一个选项,插入一个新的工作表,将准备好的数据复制到它(从而使其UsedRange与实际数据匹配),使用Worksheet.SaveAs(而不是Workbook.SaveAs)并删除工作表。

Although the actual problem here is why your UsedRange gets that big in the first place.

虽然这里的实际问题是你的UsedRange首先获得如此大的原因。