2012-04-08 147 views
2

我有一個Excel導出的銀行交易清單,我想盡可能快速,簡單地對其進行分類。我懷疑這可能只是數組公式,但VBA函數同樣有用。在Excel中對銀行交易進行分類

場景

我的電子表格的標題是這樣的:從我的銀行

| A | B   | C  | D  | 
========================================== 
| Date | Description | Amount | Category | 
------------------------------------------ 

日期,說明和金額來預填充。我填寫D列中的每筆交易的類別。

這很好,但很耗時,因爲每個類別都必須單獨輸入並手動輸入。

的需要

我希望在我還沒有進入手動分類的基礎上,動態生成和應用的規則行類別,自動填充。

我想輸出是這樣的:在列D

| A  | B    | C  | D   | E   | F   | 
============================================================================== 
| Date  | Description | Amount | Manual cat. | Rule  | Auto cat. | 
------------------------------------------------------------------------------ 
| 04/08/12 | Starbucks NYC | -$5.42 | Coffee  | starbucks | Coffee  | 
| 04/09/12 | Wal-Mart 468 | -$54.32 | Supermarket | wal-mart | Supermarket | 
| 04/10/12 | Starbucks SF | -$3.68 |    |   | Starbucks | 

正如你所看到的,我已經進入「手動」類別無論我已經這樣做了,我已經進入一個分類「規則」然後列丞燕在使用我的條目自動填充F列,

的邏輯很簡單:

  • 當我進入一個手工類,Excel中做了兩兩件事:

    1. 填充我的手動類別中列F
    2. 創建使用Excel的地方遇到一個包含文本的描述我的規則之一應用於列E.
  • 輸入的文本規則,它填充在列中的相關類別F.

效益

這將使得簡化交易清單,添加類別和相關規則變得非常簡單。沒有類別的交易會在規則適用的地方自動填充,並且在規則不適用的地方留空。已應用規則給出錯誤類別的交易可以更正,並提供新規則。

我最好的嘗試到目前爲止

我創建了這樣做只使用公式的一種方式,但它有三個缺點:

  1. 它需要儘可能多的列交易的創建。
  2. 沒有方便的方式列出類別和相關規則。
  3. 沒有改變規則中應用順序的方式。
+0

這是堆棧溢出的主題。作爲一個非編程問題,它更適合於超級用戶 – brettdj 2012-04-08 13:41:53

+0

我已經修改了這個問題,以消除只關注公式的方法。 VBA解決方案感激地接受。 – Matt 2012-04-08 16:46:41

+0

我的系統處理和合並我的各種帳戶的報表是舊的,並在接縫處嘎嘎作響。我決定用你的問題作爲替代的藉口。完成之前一兩天,因爲我還有其他任務。其他人可能會提前給出滿意的解決方案,但如果不能,我會在本週晚些時候爲您提供一些幫助。 – 2012-04-09 11:50:35

回答

0

我與我的信用卡對賬單類似的東西。我使用VBA是因爲我發現描述不一致,需要使用不同的技術對它們進行分類。

我使用的方法是有一個我稱之爲規則包含的工作表:

Organisation  Category 
Starbucks NYC Coffee shop 
Starbucks SF  Coffee shop 
Wal-Mart 468  Supermarket 

注意,我有每個分支一行。如果你經常旅行但沒有一致性,那麼這是一個痛苦的選擇。

在聲明的D列中,我鍵入=VLOOKUP(B2,Rule!A:B,2,FALSE),然後複製它。

每月新組織被歸類爲「#N/A」。我要麼輸入一次性分類,要麼將組織添加到工作表規則中。

+0

感謝您的回答。我真的在尋找能自動創建和應用基於單元一部分的規則的東西。 – Matt 2012-04-08 16:48:39

+0

你的意思是說你想在描述的任何地方「星巴克」導致類別「咖啡廳」?這就是我的系統所做的,但我不知道如何用公式來做到這一點。我可以爲你提供一個VBA解決方案。也許其他人可以爲您提供更復雜的基於配方的解決方案。 – 2012-04-08 18:04:13

1

介紹

正如我指出比早先的解決方案,因爲

被過度設計你急需它是專爲我的需要,這是更多樣化的比你在你的問題清單:

  • 我正在更換銀行,所以我有兩個當前(支票)帳戶和兩個信用卡帳戶。我也有一些儲蓄賬戶。我爲幾個工作簿中的所有這些賬戶擁有電子 報表,這些賬戶具有不同的格式。
  • 您的示例語句與我收到的語句相比非常整齊。這些是最近萬事達卡聲明中的一些說明,我整理了 「組織名稱,位置」的首選格式。

SAINSBURY'S S/MKT MONKS CROSS 
Amazon *Mktplce EU-UK AMAZON.CO.UK LUX 
WRAP LOUGHBOROUGH 
SAINSBURYS PETROL MONKS CROSS 
  • 像你我交易分類。
  • 有些組織提前每年或每季度提前或拖欠。我的收入每個月都不一樣。對於這些交易,我在適當的月份分配金額,以便更好地反映我真實的財務狀況。

我對這些多重要求的解決方案是爲每個帳戶都有一個控制例程,它知道它在哪裏以及每列用於什麼。這些稱爲一般例程,其中 接受工作簿,工作表等作爲參數並執行必要的轉換和添加。在這些轉換和補充的心臟是一個工作表我已經叫 「規則」,它有三列:

RuleType  A code such as "OrgCat" 
In-keyword  A string, such as "Starbucks", to be found in a text column 
Out-keyword A string, such as "Coffee", to be returned if the In-keyword 
       is found 

,我使用包括其他規則類型:

"OrgOrg" Convert an organisation name used in the source statement to my 
      preferred name for the organisation. 
"CatPer" Return a code identifying the apportioning rule for a category. For 
      example, "Utility" returns "B3" (Back 3) because my utility bills 
      are issued for three months in arrears. 

在您的問題,有你的賬戶的「scenerio版本」和你的賬戶的「需要版本」。我假設您已經手動創建了您的帳戶的「需要版本」,以便您可以看到它的外觀。我已經提供了一個宏,CopyFromAcctToRule(),用於處理帳戶的「需要版本」,驗證和提取「OrgCat」類型的規則。如果發現沒有錯誤,則將提取的規則輸出到工作表「規則」並將「需要版本」轉換爲「scenerio版本」。如果您尚未創建「需要的版本」,我懷疑最簡單的方法是創建一個部分「需要的版本」是這樣的:

| A  | B    | C  | D   | E   | 
================================================================ 
| Date  | Description | Amount | Category | Rule  | 
| 04/08/12 | Starbucks NYC | -$5.42 | Coffee  | Starbucks | 
| 04/09/12 | Wal-Mart 468 | -$54.32 | Supermarket | Wal-Mart | 
| 04/10/12 | Starbucks SF | -$3.68 |    |   | 
| 04/11/12 | Wal-Mart 512 |-$123.45 |    |   | 

也就是說,找到第一個星巴克,在其類別和規則填寫;找到第一個沃爾瑪並填寫其分類和規則;等等。運行CopyFromAcctToRule(),它將在列「G」中顯示錯誤消息,以瞭解您錯過的不一致和組織。對於一次性,請填寫類別,但將規則留空。重複,修復錯誤並運行CopyFromAcctToRule(),直到找到沒有錯誤並創建工作表「規則」。注意:這個階段不會添加缺少的類別;那發生在下面。

我已經提供了一個宏FillDerivedCol(),演示瞭如何通過完成「scenerio版本」帳戶的類別列來使用它。如果您不想創建部分「需要版本」,FillDerivedCol()提供了一種替代方法。如果它找不到描述的類別,它會將描述複製到工作表「規則」的底部。例如,假設你拼錯對星巴克的規則,「規則」將被修改爲:

| A  | B    | C   | 
=========================================== 
| Type  | In keyword | Out keyword | 
| OrgCat | Sarbucks  | Coffee  | 
| OrgCat | Wal-Mart  | Supermarket | 
| OrgCat | Starbucks NYC |    | 
| OrgCat | Starbucks SF |    |    

也就是說,將有星巴克的每個分支一個新行。在這裏,最簡單的方法是糾正Sarbucks行並刪除新行。但是,如果它是一個新組織,則可以編輯In關鍵字以刪除分支信息並在Out-keyword列中輸入Category。警告:我的答案超過了30,000個字符的限制。我不得不編輯這些例程以刪除診斷代碼。我希望在做這件事時我沒有引入任何錯誤。

我希望這是有用的。祝你好運。

全球

這些全局常量和日常用上述兩種宏使用。我把它們放在他們自己的模塊中,但這是你的選擇。

Option Explicit 
    ' I use constant for objects such as column numbers which are fixed 
    ' for long periods but which might change. Any code using a column 
    ' that has moved can be updated by changing the constant. 
    Public Const ColRuleType As Long = 1 
    Public Const ColRuleKeywordIn As Long = 2 
    Public Const ColRuleKeywordOut As Long = 3 
    Public Const ColRuleLast As Long = 3 
    Public Const RowRuleDataFirst As Long = 2 

    ' Rules are accumulated in this array by CopyFromAcctToRule 
    ' Rules are loaded to this array by UpdateNewTransactions 
    ' See GetRuleDetails() for a description of this array. 
    Public RuleData() As Variant 
Public Sub GetRuleDetails(ByVal RuleType As String, ByVal SrcText As String, _ 
          ByRef KeywordIn As String, ByRef KeywordOut As String, _ 
          Optional ByRef RowRuleSrc As Long) 

    ' This routine performs a case-insensive search of a list of in-keywords for 
    ' one that is present in SrcText. If one is found, it returns the in-keyword 
    ' and the matching out-keyword. 

    ' This routine uses the previously prepared array RuleData. Since RuleData 
    ' is to be loaded to, or has been loaded from, a worksheet, the first 
    ' dimension is for the rows and the second dimension is for the columns. 

    ' RuleData has three columns: 
    ' * RuleType: a code identifying a type of rule. Only rows in RuleData for 
    ' which this column matches the parameter RuleType will be considered. 
    ' * KeywordIn: a string. The first row in RuleData where the value of this 
    ' column is contained within parameter SrcText is the selected Rule. 
    ' * KeywordOut: a string. 

    ' Input parameters 
    ' * RuleType: Foe example, the rule type "OrgCat" will return a 
    ' category for an organisation. 
    ' * SrcText: The text field to be searched for the in keyword. 

    ' Output parameters 
    ' * KeywordIn: The value from the KeywordIn column of RuleData for the first 
    ' row of RuleData of the required RuleType for which the KeywordIn value can 
    ' be found in Desc. The value in SrcText may be of any case although it is 
    ' likely to be capitalised. This value is the preferred display value. 
    ' * KeywordOut: The value from the KeywordOut column of RuleData of the 
    ' selected row. For this routine, KeywordOut is a string with no 
    ' significance. It is the calling routine that understands the rule type. 
    ' * RowRuleSrc: Only used during build of RuleData so the caller can access 
    ' non-standard data held in RuleData during build. 

    Dim LCSrcText As String 
    Dim RowRuleCrnt As Long 

    LCSrcText = LCase(SrcText) 
    For RowRuleCrnt = RowRuleDataFirst To UBound(RuleData, 1) 
    If RuleData(RowRuleCrnt, ColRuleKeywordIn) = "" Then 
     ' Empty row. This indicated end of table during build 
     KeywordIn = "" 
     KeywordOut = "" 
     Exit Sub 
    End If 
    If RuleType = RuleData(RowRuleCrnt, ColRuleType) Then 
     ' This row is for the required type of rule 
     If InStr(1, LCSrcText, _ 
        LCase(RuleData(RowRuleCrnt, ColRuleKeywordIn))) <> 0 Then 
     ' Have found first rule with KeywordIn contained within SrcText 
     KeywordIn = RuleData(RowRuleCrnt, ColRuleKeywordIn) 
     KeywordOut = RuleData(RowRuleCrnt, ColRuleKeywordOut) 
     If Not IsEmpty(RowRuleSrc) Then 
      RowRuleSrc = RowRuleCrnt 
     End If 
     Exit Sub 
     End If 
    End If 
    Next 
    ' No rule found 
    KeywordIn = "" 
    KeywordOut = "" 

End Sub 

提取規則和轉換賬戶的極品之情況作風

看到介紹了我會怎麼用這個程序的細節。一旦爲現有交易構建了工作表「規則」,此代碼可能沒有其他價值。我會將它放在自己的模塊中,以便在使用後將其歸檔並刪除。此代碼假定工作表「規則」和「Matt's Acct」位於同一工作簿中。我建議你複製一個帳戶的副本,創建工作表「規則」,然後在複製帳戶上運行CallCopyFromAcctRule()並評估結果。警告:我在使用「in-keyword」的地方使用「規則」;我試圖在我的評論和錯誤消息中保持一致,但不能保證我擁有。

Option Explicit 
Sub CallCopyFromAcctRule() 

    ' This routine exists simply to make it easy to change the names of the 
    ' worksheets accessed by CallCopyFromAcctRule. 

    Call CopyFromAcctToRule("Rule", "Matt's Acct") 

End Sub 
Sub CopyFromAcctToRule(ByVal Rule As String, ByVal Acct As String) 

    ' * This routine builds the worksheet Rule from worksheet Acct. 
    ' * It works down worksheet Acct extracting rules from rows where 
    ' there is both a Rule and a Category. Note: this routine does not 
    ' distinguish between Manual and Automatic Categories although, if both are 
    ' present, they must be the same. 
    ' * The routine checks for a variety of error and possible error conditions. 
    ' Error and warning messages are placed in columns defined by ColAcctError 
    ' and ColAcctWarn. 
    ' * If any errors are found, the routine does not change either worksheet 
    ' Acct, apart from adding error messages, or worksheet Rule. 
    ' * If no errors are found, worksheet Rule is cleared and the contents of 
    ' RuleData written to it. 
    ' * If no errors are found, any warning added to worksheet Acct are discarded 
    ' and the following additional changes made: 
    ' * The values in the Automatic category column are merged into the Manual 
    '  category column which is relabelled "Category". 
    ' * The Rule and Automatic category columns are cleared. 

    Dim ColAcctCatAuto As Long 
    Dim ColAcctCatMan As Long 
    Dim ColAcctCrnt As Long 
    Dim ColAcctDesc As Long 
    Dim ColAcctError As Long 
    Dim ColAcctRule As Long 
    Dim ColAcctWarn As Long 
    Dim ColRuleRowSrc As Long 
    Dim DescCrnt As String 
    Dim ErrorFoundAll As Boolean 
    Dim ErrorFoundCrnt As Boolean 
    Dim KeywordInCrnt As String 
    Dim KeywordInRetn As String 
    Dim KeywordOutCrnt As String 
    Dim KeywordOutRetn As String 
    Dim RowAcctCrnt As Long 
    Dim RowAcctDataFirst As Long 
    Dim RowAcctLast As Long 
    Dim RowRuleCrntMax As Long 
    Dim RowRuleSrc As Long 

    ' These column values must be changed if the true value do not match those 
    ' in the example in the question. 
    ColAcctDesc = 2 
    ColAcctCatMan = 4 
    ColAcctRule = 5 
    ColAcctCatAuto = 6 
    ColAcctError = 8 
    ColAcctWarn = 9 
    ColRuleRowSrc = ColRuleLast + 1 
    RowAcctDataFirst = 2 

    With Worksheets(Acct) 
    RowAcctLast = .Cells.SpecialCells(xlCellTypeLastCell).Row 

    ' Size the array for the output data ready to be loaded to worksheet 
    ' Rule with rows as the first dimension. Allow for the maximum number of 
    ' rows because an array cannot be resized to change the number of 
    ' elements in the first dimension. Allow an extra column for use during 
    ' the build process. 
    ReDim RuleData(1 To RowAcctLast, 1 To ColRuleRowSrc) 
    RuleData(1, ColRuleType) = "Type" 
    RuleData(1, ColRuleKeywordIn) = "In keyword" 
    RuleData(1, ColRuleKeywordOut) = "Out keyword" 
    RowRuleCrntMax = 1  ' Last currently used row 

    With .Cells(1, ColAcctError) 
     .Value = "Error" 
     .Font.Bold = True 
    End With 
    With .Cells(1, ColAcctWarn) 
     .Value = "Warning" 
     .Font.Bold = True 
    End With 

    ErrorFoundAll = False 
    For RowAcctCrnt = RowAcctDataFirst To RowAcctLast 
     .Cells(RowAcctCrnt, ColAcctError).Value = "" ' Clear any error or warning 
     .Cells(RowAcctCrnt, ColAcctWarn).Value = "" ' from previous run 
     ErrorFoundCrnt = False 
     ' Determine Category, if any 
     If .Cells(RowAcctCrnt, ColAcctCatMan).Value = "" Then 
     ' There is no manual category. 
     If .Cells(RowAcctCrnt, ColAcctCatAuto).Value <> "" Then 
      KeywordOutCrnt = .Cells(RowAcctCrnt, ColAcctCatAuto).Value 
     Else 
      ' Neither manual nor automatic category 
      KeywordOutCrnt = "" 
     End If 
     Else 
     ' There is a manual category. Is it consistent with automatic category? 
     KeywordOutCrnt = .Cells(RowAcctCrnt, ColAcctCatMan).Value 
     If .Cells(RowAcctCrnt, ColAcctCatAuto).Value <> "" Then 
      ' Automatic category exists. It must be the same 
      ' as the manual category to be valid. 
      If LCase(KeywordOutCrnt) <> _ 
          LCase(.Cells(RowAcctCrnt, ColAcctCatAuto).Value) Then 
      ErrorFoundCrnt = True 
      .Cells(RowAcctCrnt, ColAcctError).Value = _ 
             "Manual and automatic categories different" 
      End If 
     End If 
     End If 
     If Not ErrorFoundCrnt Then 
     ' Match Rule, if any, against Category, if any 
     KeywordInCrnt = .Cells(RowAcctCrnt, ColAcctRule).Value 
     If KeywordInCrnt <> "" Then 
      ' This row has keyword 
      If KeywordOutCrnt = "" Then 
      ' Rule but no Category 
      DescCrnt = .Cells(RowAcctCrnt, ColAcctDesc).Value 
      Call GetRuleDetails("OrgCat", DescCrnt, KeywordInRetn, KeywordOutRetn) 
      If KeywordInRetn <> "" Then 
       ' Rule found that would generate a category for this Keyword. 
       ' No warning necessary 
      Else 
       ' No rule found that would generate a category for this keyword 
       ErrorFoundCrnt = True 
       .Cells(RowAcctCrnt, ColAcctError).Value = _ 
          "There is no existing rule that would " & _ 
          "generate a Category from this Rule" 
      End If 
      Else 
      ' Both Rule and Category found 
      ' Is match already recorded? 
      DescCrnt = .Cells(RowAcctCrnt, ColAcctDesc).Value 
      Call GetRuleDetails("OrgCat", DescCrnt, KeywordInRetn, _ 
                KeywordOutRetn, RowRuleSrc) 
      If KeywordInRetn <> "" Then 
       If KeywordInCrnt <> KeywordInRetn Then 
       ' A different rule would be applied to this Description 
       If InStr(1, LCase(DescCrnt), LCase(KeywordInCrnt)) = 0 Then 
        ' The current Rule is not within the Description 
        ErrorFoundCrnt = True 
        .Cells(RowAcctCrnt, ColAcctError).Value = _ 
         "The Rule in column " & Chr(64 + ColAcctRule) & _ 
         " is not within the Description. The Rule " & _ 
         "from row " & RowRuleSrc & " would generate " & _ 
         "the required Category '" & KeywordOutRetn & _ 
         "' from this Description" 
       Else 
        ' The current Rule is within the Description 
        If LCase(KeywordOutRetn) = LCase(KeywordOutCrnt) Then 
        ' It would generate the same category 
        ErrorFoundCrnt = True 
        .Cells(RowAcctCrnt, ColAcctError).Value = _ 
         "The Rule in column " & Chr(64 + ColAcctRule) & _ 
         " is within the Description but the Rule from " & _ 
         "row " & RowRuleSrc & " would be selected to " & _ 
         "generate the required Category '" & _ 
         KeywordOutRetn & "' from this Description" 
        Else 
        ' It would generate a different category 
        ErrorFoundCrnt = True 
        .Cells(RowAcctCrnt, ColAcctError).Value = _ 
         "The Rule in column " & Chr(64 + ColAcctRule) & _ 
         " is within the Description but the Rule from " & _ 
         "row " & RowRuleSrc & " would be selected to " & _ 
         "generate Category '" & KeywordOutRetn & _ 
         "', not Category '" & KeywordOutCrnt & _ 
         "', from this " & "Description" 
        End If 
       End If 
       Else 
       ' Rule already recorded 
       If LCase(KeywordOutRetn) = LCase(KeywordOutCrnt) Then 
        ' Rule already recorded for this category. No action required. 
       Else 
        ' Rule already recorded but not for this category 
        ErrorFoundCrnt = True 
        .Cells(RowAcctCrnt, ColAcctError).Value = _ 
           "The rule from row " & RowRuleSrc & _ 
           " would generate category """ & _ 
           KeywordOutRetn & """ for this Rule" 
       End If 
       End If 
      Else 
       ' New rule 
       RowRuleCrntMax = RowRuleCrntMax + 1 
       RuleData(RowRuleCrntMax, ColRuleType) = "OrgCat" 
       RuleData(RowRuleCrntMax, ColRuleKeywordOut) = KeywordOutCrnt 
       RuleData(RowRuleCrntMax, ColRuleKeywordIn) = KeywordInCrnt 
       RuleData(RowRuleCrntMax, ColRuleRowSrc) = RowAcctCrnt 
      End If 
      End If ' If CatCrnt = "" 
     Else 
      ' No keyword 
      If KeywordOutCrnt = "" Then 
      ' No Keyword and no Category 
      DescCrnt = .Cells(RowAcctCrnt, ColAcctDesc).Value 
      If DescCrnt = "" Then 
       ' Probably a blank line. Ignore 
      Else 
       ' Would an existing rule generate a Category for Description 
       Call GetRuleDetails("OrgCat", DescCrnt, KeywordInRetn, KeywordOutRetn) 
       If KeywordInRetn = "" Then 
       ' No rule found that would generate a category 
       ' for this description 
       .Cells(RowAcctCrnt, ColAcctError).Value = _ 
          "There is no rule that would generate " & _ 
          "a Category from this Description" 
       Else 
       ' Rule found that would generate a category for 
       ' this description. 
       End If 
      End If 
      Else 
      ' No Keyword but have Category 
      ' Check for a rule that would give current category 
      ' from current description 
      DescCrnt = .Cells(RowAcctCrnt, ColAcctDesc).Value 
      Call GetRuleDetails("OrgCat", DescCrnt, KeywordInRetn, _ 
                KeywordOutRetn, RowRuleSrc) 
      If KeywordInRetn <> "" Then 
       ' Have found a rule for the description 
       If LCase(KeywordOutRetn) = LCase(KeywordOutCrnt) Then 
       ' Rule generates current category 
       Else 
       ' Rule does not generate current category 
       ErrorFoundCrnt = True 
       .Cells(RowAcctCrnt, ColAcctError).Value = _ 
        "The rule from row " & RuleData(RowRuleSrc, ColRuleRowSrc) & _ 
        " would generate Category '" & KeywordOutRetn & _ 
        "' from this Description" 
       End If 
      Else 
       ' There is no rule for this Description. This is not necessarily 
       ' an error. The category may have to be set manually. 
       .Cells(RowAcctCrnt, ColAcctWarn).Value = _ 
          "There is no rule that would generate " & _ 
          "this Category from this Description" 
      End If 
      End If ' If KeywordOutCrnt = "" 
     End If  ' KeywordInCrnt <> "" 
     End If ' If Not ErrorFoundCrnt 
     If ErrorFoundCrnt Then 
     ErrorFoundAll = True 
     End If 
    Next 
    End With 

    If ErrorFoundAll Then 
    Exit Sub 
    End If 

    ' No errors found 

    ' Clear existing contents from worksheet Rule and load with RuleData 
    With Worksheets(Rule) 
    .Cells.EntireRow.Delete 
    .Range(.Cells(1, 1), .Cells(RowRuleCrntMax, _ 
             ColRuleKeywordOut)).Value = RuleData 
    .Range("A1:C1").Font.Bold = True 
    .Columns.AutoFit 
    End With 

    With Worksheets(Acct) 
    ' Merge values from automatic category column into manual category column 
    For RowAcctCrnt = 2 To RowAcctLast 
     If .Cells(RowAcctCrnt, ColAcctCatMan).Value = "" Then 
     ' There is no manual category so set to automatic category. 
     .Cells(RowAcctCrnt, ColAcctCatMan).Value = _ 
            .Cells(RowAcctCrnt, ColAcctCatAuto).Value 
     End If 
    Next 
    ' Clear automatic category 
    .Columns(ColAcctCatAuto).ClearContents 
    ' Change column heading 
    With .Cells(1, ColAcctCatMan) 
     .Value = "Category" 
     .Font.Bold = True 
    End With 
    ' Clear Error and Warning columns 
    .Columns(ColAcctError).ClearContents ' Only heading to clear 
    .Columns(ColAcctWarn).ClearContents 
    ' Clear Rule column 
    .Columns(ColAcctRule).ClearContents 
    End With 

End Sub 

完成你之情況版帳戶

的類別列這表明我如何填寫新的交易類別列。

Option Explicit 
Sub CallFillDerivedCol() 

    ' I use FillDerivedCol() on worksheets loaded with transactions for different 
    ' accounts. They are in different workbooks, different worksheets and have 
    ' different columns. This routine exists to call FillDerivedCol() for my 
    ' test version of your account 

    Call FillDerivedCol(ActiveWorkbook, "Rule", _ 
         ActiveWorkbook, "Matt's Acct", "OrgCat", 2, 4) 

    ' For this example, I had the rules and the account in same workbook. To 
    ' have them in different workbooks, as I normally do, you will need something 
    ' like: 

    ' Dim PathCrnt As String 
    ' Dim WBookOrig As Workbook 
    ' Dim WBookOther As Workbook 

    ' Set WBookOrig = ActiveWorkbook 
    ' PathCrnt = ActiveWorkbook.Path & "\" 
    ' Set WBookOther = Workbooks.Open(PathCrnt & "xxxxxxx") 

    ' Call FillDerivedCol(WBookOrig, "Rule", _ 
    '      WBookOther, "Matt's Acct", "OrgCat", 2, 4) 

    ' WBookOther.Close SaveChanges:=True 

End Sub 
Sub FillDerivedCol(ByVal WBookRule As Workbook, ByVal WSheetRule As String, _ 
        ByVal WBookTrans As Workbook, ByVal WSheetTrans As String, _ 
        ByVal RuleType As String, _ 
        ByVal ColSrc As Long, ByVal ColDest As Long) 

    ' Fill any gaps in WBookTrans.Worksheets(WSheetTrans).Columns(ColDest) based on 
    ' rules in worksheet WBookRule.Worksheets(WSheetRule). 

    ' WBook.Worksheets(WSheetTrans).Columns(ColSrc) is a text field which 
    ' contains in-keywords. Rules of type RuleType convert in-keywords to 
    ' out-keywords which are the values required for .Columns(ColDest). 

    Dim CellEmptyDest As Range 
    Dim KeywordIn As String 
    Dim KeywordOut As String 
    Dim MissingRule() As Variant 
    Dim RowAcctCrnt As Long 
    Dim RowAcctPrev As Long 
    Dim RowMissingCrntMax As Long 
    Dim RowRuleLast As Long 

    ' Load array RuleData from worksheet Rule 
    With WBookRule.Worksheets(WSheetRule) 
    RowRuleLast = .Cells(Rows.Count, 1).End(xlUp).Row 
    RuleData = .Range(.Cells(1, 1), .Cells(RowRuleLast, ColRuleLast)).Value 
    End With 

    ' * Prepare MissingRule() in case any calls to GetRuleDetails() fails to 
    ' find a known in-keyword in WBook.Worksheets(WSheetName).Columns(ColDest). 
    ' * The number of occurrences of the first dimension cannot be changed. 500 
    ' is intended to be more occurrences than could possible be needed. If 
    ' more than 500 missing rules are found, only the first 500 will be added 
    ' to worksheet "Rule" This routine can be immediately run again to add 
    ' another 500 missing rules. 
    ReDim MissingRule(1 To 500, 1 To ColRuleLast) 
    RowMissingCrntMax = 0 

    With WBookTrans 
    With .Worksheets(WSheetTrans) 
     RowAcctPrev = 1 
     ' Find the next empty cell in column ColDest for a transaction row 
     Set CellEmptyDest = .Columns(ColDest).Find(What:="", _ 
         After:=.Cells(RowAcctPrev, ColDest), LookIn:=xlFormulas, _ 
         LookAt:=xlWhole, SearchOrder:=xlByRows, _ 
         SearchDirection:=xlNext, MatchCase:=False, _ 
         SearchFormat:=False) 
     Do While True 
     If CellEmptyDest Is Nothing Then 
      ' No empty cell found in column. This is not a realistic situation 
      ' because it would require every row in the worksheet to have a value. 
      Exit Do 
     End If 
     RowAcctCrnt = CellEmptyDest.Row 
     If RowAcctCrnt < RowAcctPrev Then 
      ' Have looped back to the top. This is not a realistic situation 
      ' because it would require every row in the worksheet to have a value. 
      Exit Do 
     End If 
     If .Cells(RowAcctCrnt, ColSrc).Value = "" Then 
      ' This row has no value in either the source or the destination 
      ' columns. Assume all transactions finished 
      Exit Do 
     End If 
     Call GetRuleDetails(RuleType, .Cells(RowAcctCrnt, ColSrc).Value, _ 
                  KeywordIn, KeywordOut) 
     If KeywordIn = "" Then 
      ' No in-keyword found within source column. Add source column value 
      ' to MissingData for user to edit. 
      If RowMissingCrntMax >= UBound(MissingRule, 1) Then 
      ' All available rows in MissingRule already used 
      Else 
      RowMissingCrntMax = RowMissingCrntMax + 1 
      MissingRule(RowMissingCrntMax, ColRuleType) = RuleType 
      MissingRule(RowMissingCrntMax, ColRuleKeywordIn) = _ 
               .Cells(RowAcctCrnt, ColSrc).Value 
      End If 
     Else 
      .Cells(RowAcctCrnt, ColDest).Value = KeywordOut 
     End If 
     RowAcctPrev = RowAcctCrnt 
     Set CellEmptyDest = .Columns(ColDest).FindNext(CellEmptyDest) 
     Loop 
    End With 
    End With 

    If RowMissingCrntMax > 0 Then 
    ' Transactions found for which no rule exists. Add to worksheet "Rule" 
    ' for attention by the user. 
    With WBookRule.Worksheets(WSheetRule) 
     RowRuleLast = .Cells(Rows.Count, 1).End(xlUp).Row 
     .Range(.Cells(RowRuleLast + 1, 1), _ 
      .Cells(RowRuleLast + RowMissingCrntMax, ColRuleLast)).Value _ 
                   = MissingRule 
    End With 
    End If 

End Sub 
+1

我可能會使用那一天;)只是一個評論:我更喜歡使用枚舉與常量的列,因爲它們提供了3件事:命名空間,自動增量,輕鬆插入一個新的列而無需更改任何東西。 – assylias 2012-04-15 20:30:35

+0

@assylias。我沒有想過以這種方式使用枚舉。感謝您的建議。 – 2012-04-16 10:43:22

0

這似乎是一個死衚衕,但當我的銀行要求我提供有關我的每月支出的詳細信息時,我提出了同樣的問題。

我不想編寫VBA,所以我寫了一個PowerShell腳本來爲我做。它有一個名爲$Rules的數組,您可以在其中定義模式及其類別。匹配的最後一個模式將是項目的類別。我在每個模式和使用類操作符的末尾添加*。

這有點慢,因爲PowerShell訪問Excel單元格速度慢,並且需要幾分鐘時間處理我在銀行對帳單導出中的1000行。 $DesColumn指的是存儲銀行對賬單的說明欄,$CatColumn是存儲類別的欄。

應用腳本後,您可以使用Excel PIVOT功能創建總結數據的餅圖。記得做一個文件的備份!

$xl = New-Object -comobject Excel.Application 
# Show Excel 
$xl.visible = $false 
$xl.DisplayAlerts = $False 
# Create a workbook 
$wb = $xl.Workbooks. open("C:\Accounting\Accounting_2013.xls") 
# Get sheets 
$ws = $wb.WorkSheets.item("Costs") 
$ws.activate() 
$DescColumn = 6 
$CatColumn = 7 
$Rng = $ws.UsedRange.Cells 
$intRowMax = $Rng.Rows.Count 
#$intRowMax = 50 
$Rules [email protected](
@("*FOOD","GROCERY"), 
@("*Hotel","FUN"), 
@("*ADVENTURES","FUN"), 
@("CINEPLEX","FUN"), 
    @("EVENT CINEMAS","FUN"), 
@("*Rent","RENT"), 
@("Wdl ATM","ATM"), 
@("IKEA","HOME"), 
@("FORM HOME","HOME"), 
    @("KMART","HOME"), 
    @("BIG W","HOME"), 
    @("PILLOW TALK","HOME"), 
    @("BUNNING","HOME") 
@("IGA","GROCERY"), 
    @("COLES","GROCERY"), 
    @("ALDI","GROCERY"), 
    @("FRUITY CAPERS","GROCERY"), 
@("WOOLWORTHS","GROCERY"), 
    @("MEGAFRESH","GROCERY"), 
@("CALTEX","CAR"), 
@("COLES EXP","CAR"), 
@("CTX WOW","CAR"), 
@("BP EXPRESS","CAR"), 
@("QLD TRANSPORT","CAR"), 
@("REPCO","CAR"), 
@("FREEDOM FUEL","CAR"), 
@("BP THE GAP","CAR"), 
@("MCDONALDS","DINE"), 
@("RED ROOSTER","DINE"), 
@("*SIZZLER","DINE"), 
@("DOMINO","DINE"), 
    @("SUBWAY","DINE"), 
@("ROUTE 74","DINE"), 
@("KFC","DINE"), 
@("*PIZZA","DINE"), 
@("GUZMAN","DINE"), 
@("NANDOS","DINE"), 
@("*PIZZERI","DINE"), 
@("MISS INDIA","DINE"), 
@("INDIAN FEAST","DINE"), 
@("VIVIDWIRELESS","BILL"), 
@("TPG","BILL"), 
@("AGL","BILL"), 
@("EnergyAustralia","BILL"), 
@("TRANSLINK","PTRANSPORT") 
) 
for ($intRow = 2 ; $intRow -le $intRowMax ; $intRow++) { 
    $SvrName = $Rng.cells.item($intRow, $DescColumn).value2 
    ""+$intRow+"/"+$intRowMax+" "+ $SvrName 
     $Rules | ForEach-Object{ 
      $key = ($_[0])+"*" 
      if($SvrName -like $key) 
      { 
       $Rng.cells.item($intRow, $CatColumn).value2 = $_[1] 
      } 
     } 
    } 
$wb.Save() 
$wb.Close() 
$xl.Quit() 
[System.Runtime.Interopservices.Marshal]::ReleaseComObject($xl) 

0

我也一直在尋找一個自動分類過程。上面的選項看起來非常強大,但比我想要的更復雜。

我的想法很簡單:根據關鍵字制定一組分類規則。如果在描述中找到關鍵字,則應用該規則並設置類別。不開心的時候使用VBA或PowerShell中的想法,不停地環顧四周,發現下面的帖子:

how-to-group-excel-items-based-on-custom-rules由約翰·布斯托斯(請記入他)

約翰的解決方案使用了一個非常簡單的方法:

  1. 規則在兩列( - 類別關鍵字) - 定義,如果我們假定它們是在F和G列:

    Column F  Column G 
    Keyword  Category 
    Starbucks Coffee shop 
    Wal-Mart  Supermarket 
    Safeway  Supermarket 
    In-N-Out  Fast Food 
    Comcast  Internet Service 
    Verizon  Mobile Phone Service 
    
  2. ŧ母雞這個數組公式添加到要插入指向要檢查該規則的細胞類別的細胞(假設爲單元格A2):

    =IFERROR(INDEX(G$2:G$7,MATCH(TRUE,ISNUMBER(SEARCH(F$2:F$7,A2)),0)),"Other") 
    

    記得使用CTRL + SHIFT + Enter以確保它作爲數組公式進入。如果您有更多規則,則需要更改範圍高度。之後,您可以簡單地將公式填充到需要分類的所有行中。 此外,分類使用第一條規則並堅持這一規則,所以如果您在一個目標單元格中​​存在兩個不同的關鍵字,則將應用第一個關鍵字分類規則。 規則必須手動創建,當單元格顯示「其他」時,表示沒有找到關鍵字。

最後,功勞歸功於John Bustos,he is the one that provided the solution here。我發現他的解決方案非常簡單並且非常容易實現,所以我想將它包含在這裏,因爲通過「excel中的自動分類」搜索沒有立即提供。我不得不嘗試其他搜索詞。