哦，这太吓人了。我现在有一个几乎相同的任务——除了我的是从 SQL 导入到 Excel 的每月飞行日志，它必须将每天的工作时间转移到飞行员的个人工作表中。将“帐户”切换为“试点”，将“金额”切换为“飞行时间”，我们的项目完全一样。
我实际上只是在下面剪切并粘贴了我的代码，它会为您完成整个shabang。在 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
在 OP 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