Excel VBA - 帮助比较范围和数组

Question

我有这本工作簿，我一直在尝试通过宏代码开始工作。我得到了一些帮助，但似乎没有人明白我在追求什么。这是一个工作簿，用于跟踪和保存我们公司每个用户收到的工作服数量的摘要。所以，基本上，我在这本工作簿中有三张纸：https://skydrive.live.com/view.aspx?cid=5D018DB0458F03ED&resid=5D018DB0458F03ED%21163

• 总结
• 用户
• 文章

总体思路是，我将根据摘要表中的数据创建一个数据透视表。但我希望工作簿使用 vba 代码是动态的。所以我会在这里浏览每张纸。

用户：此工作簿仅包含一列 (A)，A1 称为“名称”，其下的每一行都包含我们公司的每个用户。

文章：此工作簿包含两列，A1 是文章的名称（裤子等），另一列是该商品的价格。

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

因此，棘手的部分是实际反映用户和文章表中的内容，但仍保留摘要表中 D 列的数据。另请记住，如果我从用户表中删除一行，则需要从摘要表中完全删除该用户，包括已注册的每个项目的数量。如果我在文章表中添加一个项目，则需要在摘要表中为每个用户添加该项目。

我有一些宏代码，有人帮助我，但我并没有真正了解发生了什么。我对数组和循环并不那么健壮。这就是我现在想要学习的东西，因为我看到了学习它的潜力。

但是，我确实知道我需要从它们自己范围内的所有工作表中收集数据，并存储所有数据。然后我需要将用户范围与摘要范围进行比较，以查看用户是否存在于该范围内。如果是，请确保更新文章范围中的数据并保留 ColumnD 中的数量。如果它不在摘要表中，请添加它。每个项目也是如此。

但是，如果我输入错误的用户并且直到我为该用户添加金额后才意识到这一点怎么办？如果我然后返回用户表并重命名用户，我会丢失之前添加的所有数据吗？或者是否也可以重命名用户？在那种情况下，我可能需要每个用户的某种 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

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

Answer 1

我会首先将您的输入与输出完全分开。这是基于经验，因为几年前我为一名会计师整理了一个相当复杂的会计电子表格，该电子表格将用作总账和损益表。

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

最初的尝试试图在输入端操纵信息，但结果却是一场噩梦。一旦输入和输出分开，管理起来就容易了很多。

换句话说，有类似以下表格的内容：

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

前三个只是输入。交易是一份清单，列出了哪些物品被分配给了哪些人（多对多关系）。然后我会有一个执行如下的宏。

首先，完全清除第四张纸（输出）。然后，对于“人员”表中的每个活跃人员，浏览“事务”表并为附加到该人员的任何事务创建一个输出条目。

顺便说一句，我在上面说“活跃”，因为您可能想保留历史记录，为离开的人保留记录。那将是人物表中的某种标志。

在此过程中，您可能需要查看商品和价格。

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

您可能还需要考虑某些人/物品可能具有相同名称的可能性（甚至相同的物品可能会定期更改价格）。为此，明智的做法是为每个人和物品附加一个唯一的 ID，以确保不存在错误识别的可能性。这些唯一 ID 将存储在 Transactions 表中。

---

由于我讨论的宏重达 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

如果不知道工作表布局，它可能没有那么有用，但这是我能做的最好的事情，而不能将整个工作簿发送给您。