Sub SplitByWeek() Dim wb As Workbook Dim ws As Worksheet Dim lastRow As Long Dim startDate As Date Dim endDate As Date Dim currentRow As Long Dim weekNum As Integer Dim folderPath As String

Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
startDate = ws.Range("B2").Value
folderPath = Environ("UserProfile") & "\Desktop\"

For currentRow = 2 To lastRow
    If ws.Cells(currentRow, "B").Value - startDate >= 7 Or currentRow = lastRow Then
        weekNum = weekNum + 1
        endDate = ws.Cells(currentRow - 1, "B").Value
        If currentRow = lastRow Then
            endDate = ws.Cells(lastRow, "B").Value
        End If
        If endDate - startDate >= 0 Then
            Dim newWb As Workbook
            Set newWb = Workbooks.Add
            ws.Range("A1:B" & lastRow).AutoFilter Field:=2, Criteria1:=">=" & startDate, _
                Operator:=xlAnd, Criteria2:="<=" & endDate
            ws.Range("A1:B" & lastRow).Copy Destination:=newWb.Sheets(1).Range("A1")
            newWb.Sheets(1).Range("A1:B" & lastRow).EntireColumn.AutoFit
            newWb.SaveAs folderPath & ws.Range("A2").Value & "_" & Format(startDate, "yyyymmdd") & "-" & Format(endDate, "yyyymmdd") & ".xlsx"
            newWb.Close SaveChanges:=False
        End If
        startDate = ws.Cells(currentRow, "B").Value
    End If
Next currentRow

End Su

你是excel专家。我的office是2019版本现在有一个xlsx文件headline第1列是产品名称第2列式日期需要以日期列的第一个数据B2为起点每7天放在一个excel文件中并且将生成的excel文件输出到桌面文件夹中。分割的过程中如果空日期没有数据时不生成空白表格。请你写一个vba代码。

原文地址: https://www.cveoy.top/t/topic/fFUc 著作权归作者所有。请勿转载和采集!

免费AI点我,无需注册和登录