4

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
4

2 に答える 2

4

UsedRange単純な方法で列と行を削除せずに、それ自体を再計算する

ActiveSheet.UsedRange

または、 DRJ の 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
于 2012-07-13T05:05:48.613 に答える
2

Excel は を保存しUsedRangeます。を切り詰めるにはUsedRange、行全体を削除してファイルを保存する必要があります。

それができない場合は、新しいワークシートを挿入し、準備したデータをそこにコピーし (したがって、UsedRange一致する実際のデータを残します)、 Worksheet.SaveAs( ではなくWorkbook.SaveAs) を使用して、ワークシートを削除します。

ここでの実際の問題はUsedRange、そもそもなぜあなたがそれほど大きくなるのかということです。

于 2012-07-12T14:34:14.563 に答える