由MS Excel中的日期範圍生成的報告

我正在嘗試生成一個報告，其中總計收費天數的數據正被存儲在我的倉庫中。到目前爲止，我有一個數據透視表，設置了一個日期計數器。由MS Excel中的日期範圍生成的報告

=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

我正在試圖創建是一個宏觀的，讓我輸入一個日期範圍像'12/7/2014年20/7/2014' ，並有從內多張報告和列範圍。任何人都可以指向我一些文檔或寫一些良性的vba指向正確的方向嗎？

謝謝！

來源

2014-07-21 Matthew Macri

這可能很難，因爲你沒有提供你嘗試過的東西。所以即使我們能夠想出一些東西，我們也不確定你是否能夠理解這個想法。如果您可以使用您嘗試過的代碼的特定問題修改您的問題，那就太好了。原來，你的問題是脫離主題。 – L42

對不起，我還沒有弄清楚如何去做這件事。問題是如何根據日期範圍選擇行？我可以弄清楚如何一旦選擇就移動行。我的代碼已經在另一個宏中工作了。我只需要知道如何根據開始日期和結束日期來選擇行。有人可以給我看一些基本的代碼嗎？ –

只需檢查測試單元的日期是在開始和結束日期之間。在你的代碼中，你正在檢查字符串，而不是日期;你的第二個比較是畸形的。 –

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

來源

2014-07-22 19:01:08

由MS Excel中的日期範圍生成的報告

回答

相關問題