Excel VBA – 协助比较范围和数组

我有这个工作簿，我一直试图通过macros代码工作。 我有一些帮助，但似乎没有人理解我后。 这是一个工作簿，用于跟踪和保存公司中每个用户所收到的工作量的总结。 所以，基本上，我在这个工作簿中有三张表： https : //skydrive.live.com/view.aspx?cid=5D018DB0458F03ED&resid=5D018DB0458F03ED%21163

• 概要
• 用户
• 用品

总的想法是，我会从汇总表中的数据创build一个数据透视表。 但是我希望使用vba代码的工作簿是dynamic的。 所以我会在这里看看每一张表。

用户：这个工作簿只包含一列（A），A1被称为“名称”，下面的每行包含我们公司的每个用户。

文章：这个工作簿包含两列，A1是文章的名称（裤子等），另一个是该项目的价格。

总结：这是棘手的部分。 这张表应该反映其他两张表的数据，但是我需要跟踪每个用户收到的每件物品的数量。 我将这些数据保存在汇总表的D列中。 因此，“用户”表中的每个名称都需要重复与“文章”表中的项目相同的次数。 如果在文章中有10个项目，则名称必须重复10次。 这样，我可以说，用户收到的每个项目有多less。

所以，棘手的部分是实际镜像Users和Articles表单中的内容，但仍然保留汇总表中D列的数据。 另外请记住，如果我从“用户”表中删除一行，则需要将该用户从摘要表中完全删除，包括已注册的每个项目的数量。 如果将项目添加到“项目”工作表中，则需要为“汇总”工作表中的每个用户添加该项目。

我在那里有一些macros代码，有人帮助我，但我真的没有得到什么事情。 我没有那么坚强的数组和循环。 这就是我现在要学习的东西，因为我看到了学习它的潜力。

但是我确实需要从自己的范围内的所有工作表中收集数据，存储所有的数据。 然后，我需要比较用户范围和汇总范围，以查看用户是否在该范围内。 如果是，请确保更新“文章范围”中的数据以及保留ColumnD的金额。 如果它不在汇总表中，请添加它。 每个项目也是如此。

但是，如果我错误地input了一个用户，并且在我为这个用户添加金额之后才意识到这一点呢？ 如果我回到用户表并重命名用户，我是否会丢失之前添加的所有数据？ 还是有可能能够重命名用户？ 在这种情况下，我可能需要为每个用户提供一些ID，就像Windows中的CID一样？ 这有点太矫枉过正了吗？ 这一切都归结为什么更值得，而时间。 我真的很感谢这里的一些帮助:)

Public Sub NewCollect() ' Declare variables Dim shtUsers, shtmyArticles, shtmySummary, shtmyAmount As Worksheet Dim arrUsers, arrarticles, arramount, arrsummary As Long ' Set worksheets Set shtUsers = Sheets("Brukere") Set shtArticles = Sheets("Artikler") Set shtSummary = Sheets("Oppsummering") Set shtAmount = Sheets("Antall") ' Get range from shtUsers With shtUsers If Not .Range("A2") = "" Then arrUsers = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 2) End If End With ' Get range from shtArticles With shtArticles If Not .Range("A2") = "" Then arrarticles = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 3) End If End With ' Get range from shtAmount (The new sheet) With shtAmount If Not .Range("A2") = "" Then arramount = .Range("A2", .Cells(Rows.Count, "A").End(xlUp)).Resize(, 2) End If End With ' Get range from shtSummary With shtSummary If Not .Range("A2") = "" Then 'Here I have no idea where to even begin Else ' If Summary sheet is blank, get data from other sheet and insert ReDim tempArr(1 To UBound(arrUsers) * UBound(arrarticles), 1 To 6) For u = 1 To UBound(arrUsers) For i = 1 To UBound(arrarticles) j = j + 1 tempArr(j, 1) = arrUsers(u, 1) tempArr(j, 2) = arrUsers(u, 2) tempArr(j, 3) = arrarticles(i, 1) tempArr(j, 4) = arrarticles(i, 2) tempArr(j, 6) = arrarticles(i, 3) Next Next ' Add the data .Range("A2").Resize(j, 6).Value = tempArr End If End With 

编辑：我刚刚添加一个新的列向用户和文章表kalled ID我可以添加每个项目的ID。 现在更新我的SkyDrive上的实际工作表。

Answer 1

我首先将您的input与您的输出分开。 这是基于经验，因为我在几年前为会计师编制了一个相当复杂的会计电子表格，这个电子表格可以作为总账和损益。

控制信息在一张纸上，GL代码在另一张纸上，交易在另一张纸上，一个macros基本上经过并在另外四张纸上创build了汇总和详细的资产负债表和收入/支出报表。

最初的尝试试图操纵input端的信息，但事实certificate是一场噩梦。 一旦input和输出分开，pipe理变得更容易。

换句话说，有像下面的表格：

• 人。
• 项目。
• 交易。
• 输出。

前三个只是input。 交易是一个什么项目给人什么（一对多关系）的清单。 然后我会有一个macros如下执行。

首先清除第四张纸（输出）。 然后，对于“人员”表中的每个活动人员，通过“交易”工作表创build一个“输出”条目，用于附加到该人员的任何交易。

顺便说一句，我说'积极'以上，因为你可能要保持历史，logging周围的人离开了。 那将是People表中某种标志。

您可能需要查看项目和价格作为此过程的一部分。

您也可以将错误报告为macros的一部分，例如没有有效人员或项目的事务条目。

你也可能想考虑一些人/物品可能具有相同名称的可能性（甚至相同的物品可能会定期改变价格）。 为此，对每个人和物品附上一个唯一的ID可能是明智的，以确保不存在误识别的可能性。 这些唯一的ID将存储在“交易”表中。

---

由于我讨论的macros在37K，所以我不能在这里发表。 但是，这是处理交易表并使用余额更新帐户页面的主要处理位：

 Rem Attribute VBA_ModuleType=VBAModule Option VBASupport 1 Option Explicit Public Const TxnSheet = "Txns" Public Const TxnColId = "a" Public Const TxnColDate = "b" Public Const TxnColAcct = "c" Public Const TxnColAmt = "d" Public Const TxnColDesc = "e" Public Const TxnColNotes = "f" Public Const TxnRowStart = "2" Public Const AcctSheet = "Accts" Public Const AcctColReport = "a" Public Const AcctColType = "b" Public Const AcctColBold = "c" Public Const AcctColItalic = "d" Public Const AcctColFontPlus1 = "e" Public Const AcctColOther2 = "f" Public Const AcctColOther3 = "g" Public Const AcctColOther4 = "h" Public Const AcctColOther5 = "i" Public Const AcctColLevel = "j" Public Const AcctColSign = "k" Public Const AcctColAcct = "l" Public Const AcctColVal = "m" Public Const AcctColNotes = "n" Public Const AcctRowStart = "2" ' Process all transactions. Sub ProcessTransactions() Dim TxnId As Integer Dim Balance As Double Dim WsTxn As Worksheet Dim WsAcct As Worksheet Dim RowTxn As String Dim RowAcct As String Dim RowTxn2 As String Dim RowTxn3 As String Dim StartDate As Date Dim EndDate As Date Dim CutoffDate As Date Dim PastCutoff As Boolean ' Get user-configurable stuff StartDate = GetConfig("start_date") EndDate = GetConfig("end_date") CutoffDate = GetConfig("cutoff_date") PastCutoff = False ' For filling in transaction IDs. TxnId = 1 Set WsTxn = Worksheets(TxnSheet) Set WsAcct = Worksheets(AcctSheet) RowTxn = TxnRowStart ' Select the worksheet and cell so we can see what's happening. WsTxn.Select Range(TxnColAcct + RowTxn).Select Range(TxnColAcct + RowTxn).Show ' Process all transaction lines. Do While Range(TxnColAcct + RowTxn).Value <> "" ' Check for start of transaction (non-blank date). If Range(TxnColDate + RowTxn).Value <> "" Then ' Check date within range. If Range(TxnColDate + RowTxn).Value < StartDate Or Range(TxnColDate + RowTxn).Value > EndDate Then Range(TxnColDate + RowTxn).Select MsgBox "ERROR: ProcessTransactions: Date out of range" End End If If Range(TxnColDate + RowTxn).Value > CutoffDate Then PastCutoff = True End If ' Start of transaction, fill in transaction ID and increment. Range(TxnColId + RowTxn).Value = TxnId TxnId = TxnId + 1 ' Check that transaction is balanced. RowTxn2 = FindNextTxn(RowTxn) RowTxn3 = PrevRow(RowTxn2) Balance = 0 Do While RowTxn2 <> RowTxn RowTxn2 = PrevRow(RowTxn2) Balance = Balance + Range(TxnColAmt + RowTxn2).Value Loop If Balance > 0.001 Or Balance < -0.001 Then Range(TxnColAmt + RowTxn + ":" + TxnColAmt + RowTxn3).Select MsgBox "ERROR: ProcessTransactions: Unbalanced transaction" End End If Else ' Not transaction start, clear transaction ID column. Range(TxnColDate + RowTxn).Clear End If ' Get account line, error if account not in accounts worksheet. RowAcct = FindAccount(Range(TxnColAcct + RowTxn).Value) If RowAcct = "" Then MsgBox "ERROR: ProcessTransactions: Invalid account '" & Range(TxnColAcct + RowTxn).Value & "'" End End If ' Update accounts value. If Not PastCutoff Then WsAcct.Range(AcctColVal + RowAcct) = WsAcct.Range(AcctColVal + RowAcct) + Range(TxnColAmt + RowTxn).Value End If ' Move to next transaction. ' Sleep 50 RowTxn = NextRow(RowTxn) Range(TxnColAcct + RowTxn).Select Range(TxnColAcct + RowTxn).Show Loop Range(TxnColDate + RowTxn).Select Range(TxnColDate + RowTxn).Show End Sub 

如果不知道工作表布局，这可能不是很有用，但如果不能发送给你整个工作簿，这是最好的。