创建 CSV 文件的 VBA 循环不会在动态更新范围内复制

Question

我在 Excel 中编写了一个宏，其目的是在数据集中获取一个表格并每月输出 CSV，因此一年的数据会输出 12 个文件。除了一件事之外，这是有效的 - 它将相同的数据复制到每个文件，即第一个月的数据块，因此我会在标准年份数据集上获得 12 个包含 1 月的文件。我不明白为什么复制范围没有更新，调试打印输出暗示它是更新的？

        Option Explicit
        
        Sub CSVExporter()
            ' Declare variables
            Dim wsEnter As Worksheet
            Dim wsOutput As Worksheet
            Dim sumRange As Range
            Dim sumValue As Double
            Dim tolerance As Double
            Dim fileName As String
            Dim filePath As String
            Dim newBook As Workbook
            Dim numberOfMonths As Integer
            Dim rangeLengthOfMonths As Integer
            Dim copyRange As Range
            Dim counter As Integer
            Dim rangeFromNumber As Integer
            Dim rangeToNumber As Integer
            
            ' Define tolerance level for float comparison
            tolerance = 0.001
            
            ' Set the 'Enter' worksheet to extract variable values
            Set wsEnter = ThisWorkbook.Sheets("Enter")
            Set sumRange = wsEnter.Range("Z2")
            fileName = wsEnter.Range("Z1").Text
            filePath = ThisWorkbook.Path
            ThisWorkbook.Save
            sumValue = Application.WorksheetFunction.Sum(sumRange)
            
            ' Set the 'Output' worksheet
            Set wsOutput = ThisWorkbook.Sheets("Output")
            numberOfMonths = wsOutput.Range("J2").Value ' Number of Months to copy (will be built here in final version, not cell ref)
            rangeLengthOfMonths = wsOutput.Range("J3").Value ' Length of Each month's data range (will be built here in final version, not cell ref)
        
            If Abs(sumValue) <= tolerance Then     ' Check if sum is within the tolerance of zero
                ' Main Loop
                For counter = 1 To numberOfMonths
                    Debug.Print ("counter = " & counter)
                    rangeFromNumber = (1 + (counter - 1) * rangeLengthOfMonths)
                    rangeToNumber = (counter * rangeLengthOfMonths)
                    Debug.Print ("Range From = " & rangeFromNumber)
                    Debug.Print ("Range To = " & rangeToNumber)
                    
                    ' Define the copy range dynamically for each month
                    Set copyRange = wsOutput.Range("A" & rangeFromNumber & ":A" & rangeToNumber)
                    Debug.Print (copyRange.Address)
              
                    ' Create a new workbook for the CSV
                    Set newBook = Workbooks.Add
                    copyRange.Copy Destination:=newBook.Sheets(1).Range("A1")
                    newBook.Sheets(1).Name = "Data_Month_" & counter
                    newBook.SaveAs fileName:=filePath & "\" & fileName & "_Month_" & counter & ".csv", FileFormat:=xlCSV
                    newBook.Close SaveChanges:=False
                Next counter
                ' End Main Loop
                
                MsgBox "Files exported to CSV.", vbInformation, "Export Notification"
            Else
                MsgBox "Sum of TB is not zero. File not exported." & vbCrLf & "Please check Trial Balance for errors.", vbInformation, "Trial Balance Error"
            End If
        End Sub`

预期产出按月划分，但一遍又一遍地获得同一个月。

首次亮相打印两个月的测试数据

Range To = 546
$A$274:$A$546
counter = 1
Range From = 1
Range To = 273
$A$1:$A$273
counter = 2
Range From = 274
Range To = 546
$A$274:$A$546

Answer 1

Offset

是一种将范围向下移动多行的简单方法。

Option Explicit

Sub CSVExporter()

    Dim wbCSV As Workbook
    Dim wsEnter As Worksheet, wsOutput As Worksheet, wsCSV As Worksheet
    Dim rngSrc As Range, rngDest As Range, rngSum As Range
    Dim numberOfMonths As Long, recordsPerMonth As Long, sumvalue As Double, m As Long
    Dim msg As String, filename As String, filepath As String, pathname As String
    
    ' Define tolerance level for float comparison
    Const tolerance = 0.001
    
    ' Set the 'Enter' worksheet to extract variable values
    With ThisWorkbook
        Set wsEnter = .Sheets("Enter")
        Set wsOutput = .Sheets("Output")
        .Save
    End With
    
    ' check trial balance
    Set rngSum = wsEnter.Range("Z2")
    sumvalue = WorksheetFunction.Sum(rngSum)
    If Abs(sumvalue) > tolerance Then
        msg = "Sum is " & sumvalue _
        & vbCrLf & "Please check Trial Balance for errors."
        MsgBox msg, vbCritical, "Trial Balance > " & tolerance
        Exit Sub
    End If
    
    filename = wsEnter.Range("Z1").Text
    filepath = ThisWorkbook.Path
    
    ' Number of Months to copy (will be built here in final version, not cell ref)
    numberOfMonths = wsOutput.Range("J2").Value
    ' Length of Each month's data range (will be built here in final version, not cell ref)
    recordsPerMonth = wsOutput.Range("J3").Value
    
    ' Main Loop
    Set wbCSV = Workbooks.Add(1)
    Set wsCSV = wbCSV.Sheets(1)
    
    Set rngDest = wsCSV.Range("A1").Resize(recordsPerMonth)
    Set rngSrc = wsOutput.Range("A1").Resize(recordsPerMonth)
    pathname = filepath & "\" & filename
    
    Application.ScreenUpdating = False
    For m = 1 To numberOfMonths
        
        ' copy and save values
        rngDest.Value = rngSrc.Value
        wsCSV.SaveAs filename:=pathname & "_Month_" & Format(m, "00") & ".csv", FileFormat:=xlCSV
        
        ' next month
        Set rngSrc = rngSrc.Offset(recordsPerMonth)
        rngDest.ClearContents
    Next
    wbCSV.Close savechanges:=False
    Application.ScreenUpdating = True
    ' End Main Loop
        
    MsgBox m - 1 & " Files exported to CSV.", vbInformation, "Export Notification"
   
End Sub