使用VBA将Excel数据保存为csv - 在文件末尾删除空白行以保存 [英] Saving Excel data as csv with VBA - removing blank rows at end of file to save
问题描述
我在VBA中创建一组csv文件。
I am creating a set of csv files in VBA.
我的脚本正在创建我需要的数据集,但行数在循环的多次迭代中不同。例如,对于i = 2,我有100,000行,但是对于i = 3,我有22,000行。问题是,当Excel保存这些单独的csv文件时,它不截断结尾处的空间。这会在文件的末尾留下78,000个空白行,这是一个问题,假设我需要大约2000个文件生成,每个几兆字节大。 (我有一些数据,我需要在SQL,但不能在SQL本身的数学。)
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.)
这个问题通常发生在手动保存 - 你需要在删除行后关闭文件,然后重新打开,这在这种情况下不是一个选项,因为它在VBA中自动发生。在使用另一种语言的脚本保存之后删除空白行不是真的可以选择,因为我实际上需要输出文件以适应可用的驱动器,现在它们不必要地巨大。
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.
我尝试过 Sheets(1).Range(A2:F1000001)。ClearContents
不截断任何东西。删除行在保存之前应该同样没有效果,因为Excel会将所有行保存到文件结尾,因为它存储的是最右下方的单元格。有没有方法可以有excel只保存我需要的行?
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?
这里是我的代码用于保存:(截断发生更早,在路由中调用这一个)
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
$ b b
代码的相关位在这里:
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
推荐答案
您可以使用 UsedRange
重新计算,而不用简单的
You can get the UsedRange
to recalculate itself without deleting columns and rows with a simple
ActiveSheet.UsedRange
或者,您可以自动手动删除 false用于删除最后使用的单元格下面的区域,其中包含代码,例如 DRJ的VBAexpress文章,或使用 ASAP实用程序等插件。
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的文章的功能是:
The function from DRJ's article is;
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
这篇关于使用VBA将Excel数据保存为csv - 在文件末尾删除空白行以保存的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!