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

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

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

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

我试过Sheets(1).Range("A2:F1000001").ClearContents ,但是这不会截断任何东西。 在保存之前删除行应该类似地没有效果,因为Excel保存所有的行直到文件结束,因为它存储了操作在右下angular的单元格。 有没有办法让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 

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

 ActiveSheet.UsedRange 

或者,您可以通过删除最后使用的单元格下面的区域(例如DRJ的VBAexpress文章) ,或者使用插件(如ASAP Utilities)来自动删除“false”usedrange

DRJ的文章的function是;

 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 

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

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

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