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

Question

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

我的脚本正在创建我需要的数据集，但循环的多次迭代中行数不同。例如，对于i = 2，我有100,000行，但对于i = 3，我有22,000行。问题是，当Excel保存这些单独的csv文件时，它不会在最后截断空间。这会在文件末尾留下78,000空白行，这是一个问题，因为我需要生成大约2,000个文件，每个文件需要几兆字节。 （我在SQL中需要一些数据，但是不能在SQL本身中进行数学计算。长话短说）

当手动保存时需要关闭文件，然后重新打开，在这种情况下这不是一个选项，因为它在VBA中自动发生。在使用另一种语言的脚本进行保存后删除空白行实际上并不是一种选择，因为我实际上需要输出文件以适应可用的驱动器，而且现在它们不必要的巨大。

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

这里是用来保存我的代码：（截断发生较早，在调用这个路由）

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 

的代码中的相关位是在这里：

'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 

Answer 1

你可以得到UsedRange重新计算本身，而不删除列和行用一个简单的

ActiveSheet.UsedRange 

或者您可以通过删除上次使用的电池下方的区域自动化手工清除“假” usedrange的代码如DRJ's VBAexpress article，或通过使用插件如ASAP Utilities

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 

Answer 2

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

如果这不是一个选项，插入新工作表，准备的数据复制到它（因此留下了UsedRange匹配实际数据），使用Worksheet.SaveAs（相对于Workbook.SaveAs）和删除工作表。

虽然这里的实际问题是为什么你的UsedRange首先得到那么大。