Excel VBA - 協助比較範圍和數組

Question

我有這個工作簿，我一直試圖通過宏代碼工作。我有一些幫助，但似乎沒有人明白我的所作所爲。這是一本工作手冊，用於跟蹤和保存公司中每位用戶的工作量總結。所以，基本上，我有工作簿中的三個工作表：https://skydrive.live.com/view.aspx?cid=5D018DB0458F03ED&resid=5D018DB0458F03ED%21163

• 摘要
• 用戶
• 文章

總的想法是，我將創建從數據透視表彙總表。但我希望使用vba代碼的工作簿是動態的。所以我會在這裏討論每張表。

用戶：本工作手冊僅包含一列（A），A1被稱爲「名稱」，其下的每行包含公司中的每個用戶。

文章：此工作簿包含兩列，A1是文章的名稱（褲子等），另一個是該項目的價格。

摘要：這是一個棘手的部分。此表格應反映其他兩張表格中的數據，但我需要跟蹤每個用戶收到的每件物品的多少個。我將這些數據保存在彙總表的D列中。因此，用戶表中的每個名稱需要重複的次數與「文章」表中的項目一樣多。如果該文章中有10個項目，則該名稱必須重複10次。這樣，我可以說出用戶收到的每件物品有多少。

所以，棘手的部分是實際鏡像來自Users和Articles表單的內容，但仍然保留彙總表中D列的數據。另外請記住，如果我從用戶表中刪除一行，則需要將該用戶從摘要表中完全刪除，包括已註冊的每個項目的數量。如果我將項目添加到「文章」工作表中，則需要爲「彙總」工作表中的每個用戶添加該項目。

我有一些宏代碼，有人幫助我，但我真的沒有得到什麼事情。我沒有那麼堅強的數組和循環。這就是我現在想學習的東西，因爲我看到了學習它的潛力。

但是，我確實需要從自己的範圍內的所有工作表中收集數據，存儲所有數據。然後，我需要比較用戶範圍和彙總範圍，以查看用戶是否在該範圍內。如果是，請確保更新Articles Range中的數據並保留ColumnD的金額。如果它不在彙總表中，請添加它。每個項目也是如此。

但是，如果我輸錯用戶，直到我爲該用戶添加金額之後才意識到該怎麼辦？如果我然後回到Users表並重命名用戶，我是否會丟失之前添加的所有數據？或者是否有可能能夠重命名用戶？在那種情況下，我可能需要爲每個用戶提供一些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

我會首先將您的輸入與您的輸出完全分開。這是基於經驗，因爲我爲幾年前的會計人員編制了一份相當複雜的會計電子表格，它將作爲總賬和P & L.

控制信息在一張紙上，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 

它可能不是那麼有用不知道紙張佈局，但它是不能夠送我能做的最好的你整個工作簿。