分割分割范圍超過Usedrange的檔案時，防止宏vba復制粘貼空行

我在這里找到了一個代碼，它非常適合我想要做的事情，即將一個大的 excel 檔案分割成更小的 csv 檔案。但是，在檢查輸出 csv 時，當剩余的行數小于回圈中的數量時，輸出會復制并粘貼空行，如圖所示。有什么辦法可以防止這種情況在回圈內部發生嗎？提前致謝。

Dim rLastCell As Range
Dim rCells As Range
Dim strName As String
Dim lLoop As Long, lCopy As Long
Dim wbNew As Workbook

With Sheets("Sheet1")
Set rLastCell = .UsedRange.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious)

For lLoop = 2 To rLastCell.Row Step 3000
    lCopy = lCopy   1
    Set wbNew = Workbooks.Add
    .Rows(1).EntireRow.Copy _
    Destination:=wbNew.Sheets(1).Range("A1")
    .Range(.Cells(lLoop, 1), .Cells(lLoop   3000, .Columns.Count)).EntireRow.Copy _
    Destination:=wbNew.Sheets(1).Range("A2")
    wbNew.SaveAs Filename:="C:\Users\Documents" & 
    "product_catalog_" & fileDate & "_" & Format(lLoop   2999, "0000") & ".csv", 
    FileFormat:=xlCSV, 
    Local:=True
    wbNew.Close SaveChanges:=True
    Next lLoop
    End With

uj5u.com熱心網友回復：

為了做到這一點，我引入了一個名為 rowsToDo 的變數，最小值為 3000 或剩余的行數：

Sub testCSV()
    Dim rLastCell As Range
    Dim rCells As Range
    Dim strName As String
    Dim lLoop As Long, lCopy As Long
    Dim wbNew As Workbook
    
    With Sheets("CSV Table")
        Set rLastCell = .UsedRange.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious)
    
        For lLoop = 2 To rLastCell.Row Step 3000
            rowsToDo = rLastCell.Row - lLoop
            If rowsToDo > 3000 Then rowsToDo = 3000
            lCopy = lCopy   1
            Set wbNew = Workbooks.Add
            .Rows(1).EntireRow.Copy Destination:=wbNew.Sheets(1).Range("A1")
            .Range(.Cells(lLoop, 1), .Cells(lLoop   rowsToDo, .Columns.Count)).EntireRow.Copy Destination:=wbNew.Sheets(1).Range("A2")
            wbNew.SaveAs Filename:="C:\Users\Documents" & "product_catalog_" & fileDate & "_" & Format(lLoop   2999, "0000") & ".csv", FileFormat:=xlCSV, Local:=True
            wbNew.Close SaveChanges:=True
        Next lLoop
    End With
End Sub

請注意，然后我在復制和目標陳述句中使用它來獲取要復制的行數。

對我的問題進行了非常快速的模擬，雖然老實說我無法復制這個問題我很確定這應該可以解決它

uj5u.com熱心網友回復：

請測驗下一個方法。在復制必要的范圍（不使用剪貼板）和計算最后一個回圈的剩余非空行的確切數量方面更快。

不要忘記fileDate = "Test"用正確/必要的定義更改行（上面的代碼中缺少...）：

Sub CreateCSVFiles()
 Dim rLastCell As Range, rCells As Range, strName As String
 Dim lLoop As Long, lCopy As Long, wbNew As Workbook
 Dim lngStep As Double, iLast As Long, lastSliceRows As Long, fileDate As String

 fileDate = "Test" 'place here your real value (missing from the shown code...)
 With Sheets("Sheet1")
    Set rLastCell = .UsedRange.Find(What:="*", After:=.Range("A1"), SearchDirection:=xlPrevious)
    lngStep = 5
    For lLoop = 2 To rLastCell.row Step lngStep
        If (rLastCell.row - 1) / lngStep Mod 2 <> 0 Then
            iLast = Int((rLastCell.row - 1) / lngStep)   1
            lastSliceRows = (rLastCell.row - 1) - Int(rLastCell.row / lngStep) * lngStep:  'Stop
        Else
            iLast = Int(rLastCell.row / lngStep): lastSliceRows = lngStep
        End If
        lCopy = lCopy   1
        Set wbNew = Workbooks.Add

        'much faster way to copy the necessary values, without using clipboard:
        wbNew.Sheets(1).Range("A1").EntireRow.value = .rows(1).EntireRow.value
        wbNew.Sheets(1).Range("A2").Resize(IIf(lLoop = iLast, lastSliceRows, lngStep), Columns.count).value = _
                 .Range(.cells(lLoop, 1), .cells(lLoop   IIf(lLoop = iLast, lastSliceRows, lngStep), .Columns.count)).EntireRow.value
    
        wbNew.saveas fileName:="C:\Users\Documents" & _
              "product_catalog_" & fileDate & "_" & Format(lLoop   2999, "0000") & ".csv", _
                FileFormat:=xlCSV, Local:=True
        wbNew.Close SaveChanges:=False ' True is useless in this content, it only makes the code slower saving for the second time.
      Next lLoop
 End With
End Sub

請在測驗后發送一些反饋。

標籤：擅长 vba CSV 分裂

上一篇：python-使用polars的`read_csv`時，有沒有辦法在python中處理`emptycsv`

下一篇：以長資料格式將包含值串列的Python字典寫入CSV