Question

我试图生成一个报告，该报告总计存储在我仓库中的可计费天数。到目前为止，我有一个带有日间计数器的数据透视表。

 =IF(F3 < G3, G3 - F3, TODAY() - F3)

这是我要修改以执行此任务的代码。

 Private Sub Worksheet_Change(ByVal Target As Range)

 Dim i, LastRow
 LastRow = Range("E" & Rows.Count).End(xlUp).Row

         For i = 2 To LastRow

             If UCase(Cells(i, "J").Value) >= "START DATE" AND <= "END DATE" Then
                 Cells(i, "J").EntireRow.Copy Destination:= _
                 Sheets("Report").Range("A" & Rows.Count).End(xlUp).Offset(1)
             End If

         Next

 End Sub

我尝试创建的是一个允许我输入日期范围的宏，例如2014年12月7日至2014年10月20日。并使报告汇总该范围内多个工作表的列。有人能指点我一些文件或写一些良性的vba指向正确的方向吗？

谢谢！

Answer 1

    Sub TestRun()
Dim rSheet As Worksheet
Dim sSheet As Worksheet
Dim mSheet As Worksheet
Dim rRow As Long
Dim sRow As Long
Dim iRow As Long
Dim nRow As Long
Dim mRow As Long
Set mSheet = ThisWorkbook.Worksheets("Report")
Set rSheet = ThisWorkbook.Worksheets("Received")
Set sSheet = ThisWorkbook.Worksheets("Shipped")
rRow = rSheet.Cells(Rows.Count, 1).End(xlUp).Row
sRow = sSheet.Cells(Rows.Count, 1).End(xlUp).Row
mRow = mSheet.Cells(Rows.Count, "D").End(xlUp).Row + 1
mSheet.Range("A7:G" & mRow).ClearContents
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
With rSheet
    .Range("A1:N" & rRow).AutoFilter Field:=6, Criteria1:=">=" & Sheet5.Range("B3"), Operator:=xlAnd, _
                                Criteria2:="<=" & Sheet5.Range("B4")
    .Range("F2:F" & rRow).Copy
        mSheet.Range("A" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("B2:B" & rRow).Copy
        mSheet.Range("B" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("J2:J" & rRow).Copy
        mSheet.Range("C" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("D2:D" & rRow).Copy
        mSheet.Range("D" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("N2:N" & rRow).Copy
        mSheet.Range("E" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("A2:A" & rRow).Copy
        mSheet.Range("G" & mRow).PasteSpecial Paste:=xlPasteValues
    .AutoFilterMode = False
End With
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
With sSheet
    .Range("A1:N" & rRow).AutoFilter Field:=6, Criteria1:=">=" & Sheet5.Range("B3"), Operator:=xlAnd, _
                                Criteria2:="<=" & Sheet5.Range("B4")
    .Range("F2:F" & rRow).Copy
        mSheet.Range("A" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("B2:B" & rRow).Copy
        mSheet.Range("B" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("J2:J" & rRow).Copy
        mSheet.Range("C" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("D2:D" & rRow).Copy
        mSheet.Range("D" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("N2:N" & rRow).Copy
        mSheet.Range("E" & mRow).PasteSpecial Paste:=xlPasteValues
    .Range("A2:A" & rRow).Copy
        mSheet.Range("G" & mRow).PasteSpecial Paste:=xlPasteValues
    .AutoFilterMode = False
End With
For i = 7 To mRow
    mSheet.Cells(i, "F") = mSheet.Cells(i, "D") * mSheet.Cells(i, "E")
Next
mRow = mSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
mSheet.Range("D" & mRow + 3) = "TOTAL GROSS LBS"
mSheet.Range("E" & mRow + 3) = "TOTAL DAYS"
mSheet.Range("F" & mRow + 3) = "TOTAL BILLABLE LBS"
mSheet.Range("D" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("D7:D" & mRow))
mSheet.Range("E" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("E7:E" & mRow))
mSheet.Range("F" & mRow + 4) = Application.WorksheetFunction.Sum(mSheet.Range("F7:F" & mRow))
If Not Right(Sheet5.Range("B2"), 1) = "\" Then Sheet5.Range("B2") = Sheet5.Range("B2") & "\"
mSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
    Sheet5.Range("B2") & "\" & Sheet5.Range("D2"), Quality:= _
    xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
    OpenAfterPublish:=True
End Sub

由MS Excel中的日期范围生成的报告

1 个答案: