问根据日期复制另一列中的值范围
EN

Stack Overflow用户

提问于 2015-09-17 12:00:33

回答 1查看 4K关注 0票数 0

我正在尝试编写一个宏，该宏根据另一列中相应的日期在一列中复制一系列值。

例如，我需要复制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

vba

excel

date

for-loop

回答 1

Stack Overflow用户

回答已采纳

发布于 2015-09-18 05:28:22

哦，这太恐怖了。我现在有一个几乎相同的任务--除了我的任务是每月从SQL导入到Excel的飞行日志，它必须将每天的工作时间转移到飞行员的个人工作表中。将“帐户”改为“飞行员”和“数量”为“飞行时间”，我们的项目是完全相同的。

实际上，我已经在下面剪切和粘贴了我的代码，它将为您完成整个shabang。在StackOverflow上为他们解决整个任务并不是很好的形式，但在这种情况下，只粘贴一些过程似乎毫无意义。

对我来说，最大的教训是只把Excel当作数据检索和数据显示接口。诀窍是创建您自己的数据结构，将数据读入其中，根据需要操作/询问它们，然后在所有工作完成后将结果写入工作表。换句话说，避免像瘟疫一样的宏生成器！我更怀疑你的复制单元格x，y粘贴到单元格r，c方法会带你到相同的死胡同，我去了。我发现最好的方法是有一个飞行员的Dictionary (你的帐户)，然后是飞行日期的内部Dictionary (值/日期)。然后，您只需测试每日工作表中每个帐户的帐户密钥和日期键。

要访问Dictionary对象，您需要引用Microsoft Scripting Runtime (Tools ->引用.->通过勾选在列表中选择)。

您需要创建两个类--这是您的数据字段。调用第一个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