根據日期在另一列中復制一個值范圍

Question

我正在嘗試編寫一個宏，該宏根據另一列中的相應日期復制一列中的值范圍。

例如，我需要復制G列中與B列中的日期相對應的值。對於2015年9月18日，我需要基於B列中的日期9/18/2015選擇並復制G列中的范圍然后，我需要對9/19執行相同的操作，對於所有其他日期，依此類推。 然后，我將其粘貼到其他幾頁，盡管此處未包括該部分代碼。

我在下面的嘗試僅檢查B列中的日期，然后復制G列中的范圍。我相信我需要一個for循環，但是我不確定如何根據我的需要正確構建它。

 If ActiveCell >= Date + 1 And ActiveCell <= Date + 7 Then

' Compare date on Day Sheet to sheet s and select cells in column G
' corresponding to that date

        x = ActiveCell
        ActiveWorkbook.Sheets("s").Activate
        Range("B2").Select

' If statement to check if dates match

            If ActiveCell = x Then
            Range("G2").Select
            ActiveCell.Offset(0, 5).Select
            Range("G2:G10").Copy
            Else
            End If

Answer 1

哦，這很詭異。 我現在有一個幾乎相同的任務-除了我的是每月從SQL導入到Excel的每月飛行日志，該日志必須將每日時間轉移到飛行員的個人工作表中。 將“帳戶”更改為“試點”，將“金額”更改為“飛行時間”，我們的項目是完全相同的。

實際上，我只是在下面剪切並粘貼了我的代碼，它將為您完成整個操作。 在StackOverflow上為他們解決某人的全部任務不是很好的形式，但是在這種情況下，僅粘貼一些過程似乎毫無意義。

對我來說，最大的教訓是將Excel僅視為數據檢索和數據顯示界面。 訣竅是創建自己的數據結構，將數據讀入其中，根據需要進行操作/詢問，然后在完成所有操作后將結果寫入工作表。 換句話說，避免像瘟疫這樣的宏生成器！ 我寧可懷疑您將復制單元格x，y粘貼到單元格r，c的方法是否會將您帶到與上次相同的死角。 我發現最好的方法是先准備一個飛行員Dictionary （為您准備的帳戶），然后再准備一個航班日期的內部Dictionary （為您准備的值/日期）。 然后，您只需為工作表中的每個帳戶測試一個帳戶密鑰和一個日期密鑰。

要訪問Dictionary對象，您需要引用Microsoft Scripting Runtime （工具->引用...->選中復選框在列表中）。

您將需要創建兩個類-這些是您的數據字段。 調用第一個cAccountFields並將以下代碼添加到該類：

Public AccountName As String
Public ActivityByDate As Dictionary
Public Sub Create(accName As String)
    Me.AccountName = accName
    Set Me.ActivityByDate = New Dictionary
End Sub

調用第二個cActivityFields並將以下代碼添加到該類：

Public DateOf As Date
Public Value As Double
Public Sub Create(dat As Date, val As Double)
    Me.DateOf = dat
    Me.Value = val
End Sub

然后，只需將以下代碼添加到您的模塊即可。 私有常量需要在模塊級別（即頁面頂部）聲明。 您可以使用這些來定義行和列引用-如果它們與飛行員的日志相匹配，那確實是不可思議的：

Private Const DB_SHEET As String = "Sheet1"
Private Const DB_DATE_COL As String = "B"
Private Const DB_ACCOUNT_COL As String = "C"
Private Const DB_VALUE_COL As String = "G"
Private Const DB_ACCOUNT_START_ROW As Long = 1
Private Const DAY_DATE_ADDRESS As String = "A1"
Private Const DAY_ACCOUNT_COL As String = "A"
Private Const DAY_VALUE_COL As String = "B"
Private Const DAY_ACCOUNT_START_ROW As Long = 2


Public Sub ProcessData()
    Dim daySheets As Collection
    Dim accountsFromDB As Dictionary
    Dim account As cAccountFields
    Dim activity As cActivityFields
    Dim ws As Worksheet
    Dim dat As Date
    Dim accName As String
    Dim accValue As Double
    Dim endRow As Long
    Dim r As Long

    ' Create a Collection of the Day sheets
    Set daySheets = New Collection
    For Each ws In ThisWorkbook.Worksheets
        If Left(ws.Name, 4) = "Day " Then
            daySheets.Add ws
        End If
    Next

    ' Read the database sheet
    Set ws = ThisWorkbook.Worksheets(DB_SHEET)
    Set accountsFromDB = New Dictionary

    endRow = ws.Cells.Find(What:="*", _
                           After:=ws.Range("A1"), _
                           LookIn:=xlFormulas, _
                           LookAt:=xlPart, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlPrevious).Row

    For r = DB_ACCOUNT_START_ROW To endRow

        dat = ws.Cells(r, DB_DATE_COL).Value2
        accName = ws.Cells(r, DB_ACCOUNT_COL).Text
        accValue = ws.Cells(r, DB_VALUE_COL).Value2

        ' Add the account or retrieve it if it already exists.
        If Not accountsFromDB.Exists(accName) Then
            Set account = New cAccountFields
            account.Create accName
            accountsFromDB.Add key:=accName, Item:=account
        Else
            Set account = accountsFromDB.Item(accName)
        End If

        ' Add the value for a specific date.
        If Not account.ActivityByDate.Exists(dat) Then
            Set activity = New cActivityFields
            activity.Create dat, accValue
            account.ActivityByDate.Add key:=dat, Item:=activity
        Else
            ' If the same account and date occurs, then aggregate the values.
            Set activity = account.ActivityByDate(dat)
            activity.Value = activity.Value + accValue
        End If

    Next

    ' Populate the Day sheets
    For Each ws In daySheets

        dat = ws.Range(DAY_DATE_ADDRESS).Value2

        endRow = ws.Cells.Find(What:="*", _
                               After:=ws.Range("A1"), _
                               LookIn:=xlFormulas, _
                               LookAt:=xlPart, _
                               SearchOrder:=xlByRows, _
                               SearchDirection:=xlPrevious).Row

        For r = DAY_ACCOUNT_START_ROW To endRow

            accName = ws.Cells(r, DAY_ACCOUNT_COL).Text

            ' If account and value for this date exists then write the value
            If accountsFromDB.Exists(accName) Then
                Set account = accountsFromDB.Item(accName)
                If account.ActivityByDate.Exists(dat) Then
                    Set activity = account.ActivityByDate.Item(dat)
                    ws.Cells(r, DAY_VALUE_COL).Value = activity.Value
                End If
            End If

        Next

    Next

End Sub

在OPs Q之后更新：

在模塊級別添加其他常量，並根據需要進行修改：

Private Const DB_BOOK As String = "Macro Test File.xlsx"
Private Const DAY_BOOK As String = "Macro Test File.xlsx"
Private Const INITIAL_SHEET As String = "Initial Revenue"
Private Const INITIAL_COL As String = "E"

然后使用以下代碼：

Dim daySheets As Collection
Dim accountsFromDB As Dictionary
Dim account As cAccountFields
Dim activity As cActivityFields
Dim dbWb As Workbook
Dim dayWb As Workbook
Dim ws As Worksheet
Dim dat As Date
Dim accName As String
Dim accValue As Double
Dim endRow As Long
Dim r As Long

' Assign the workbook containing the database sheet
On Error Resume Next
Set dbWb = Workbooks(DB_BOOK)
On Error GoTo 0
If dbWb Is Nothing Then
    MsgBox "Please open " & DB_BOOK & " in this application and run this routine again."
    End
End If

' Assign the workbook containing the days sheets
On Error Resume Next
Set dayWb = Workbooks(DAY_BOOK)
On Error GoTo 0
If dayWb Is Nothing Then
    MsgBox "Please open " & DAY_BOOK & " in this application and run this routine again."
    End
End If


' Create a Collection of the Day sheets
Set daySheets = New Collection
For Each ws In dayWb.Worksheets
    If Left(ws.Name, 4) = "Day " Then
        daySheets.Add ws
    End If
Next

' Read the database sheet
Set ws = dbWb.Worksheets(DB_SHEET)
Set accountsFromDB = New Dictionary

endRow = ws.Cells.Find(What:="*", _
                       After:=ws.Range("A1"), _
                       LookIn:=xlFormulas, _
                       LookAt:=xlPart, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlPrevious).Row

For r = DB_ACCOUNT_START_ROW To endRow

    dat = ws.Cells(r, DB_DATE_COL).Value2
    accName = ws.Cells(r, DB_ACCOUNT_COL).Text
    accValue = ws.Cells(r, DB_VALUE_COL).Value2

    ' Add the account or retrieve it if it already exists.
    If Not accountsFromDB.Exists(accName) Then
        Set account = New cAccountFields
        account.Create accName
        accountsFromDB.Add Key:=accName, Item:=account
    Else
        Set account = accountsFromDB.Item(accName)
    End If

    ' Add the value for a specific date.
    If Not account.ActivityByDate.Exists(dat) Then
        Set activity = New cActivityFields
        activity.Create dat, accValue
        account.ActivityByDate.Add Key:=dat, Item:=activity
    Else
        ' If the same account and date occurs, then aggregate the values.
        Set activity = account.ActivityByDate(dat)
        activity.Value = activity.Value + accValue
    End If

Next

' Populate the Day sheets
For Each ws In daySheets

    dat = ws.Range(DAY_DATE_ADDRESS).Value2

    endRow = ws.Cells.Find(What:="*", _
                           After:=ws.Range("A1"), _
                           LookIn:=xlFormulas, _
                           LookAt:=xlPart, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlPrevious).Row

    For r = DAY_ACCOUNT_START_ROW To endRow

        ' Write the standard formula into the cell
        ws.Cells(r, DAY_VALUE_COL).Formula = "='" & INITIAL_SHEET & "'!" & _
                                             INITIAL_COL & CStr(r)

        accName = ws.Cells(r, DAY_ACCOUNT_COL).Text

        ' If account and value for this date exists then write the value
        If accountsFromDB.Exists(accName) Then
            Set account = accountsFromDB.Item(accName)
            If account.ActivityByDate.Exists(dat) Then
                Set activity = account.ActivityByDate.Item(dat)
                ws.Cells(r, DAY_VALUE_COL).Formula = ws.Cells(r, DAY_VALUE_COL).Formula & _
                                                     " + " & CStr(activity.Value)
            End If
        End If

    Next

Next