在Excel中对银行交易进行分类

我在Excel中有一个导出的银行交易清单，我想尽可能简单快捷地将其分类。 我怀疑这可能只是数组公式，但一个VBA函数也同样有用。

情景

我的电子表格标题如下所示：

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

date，说明和金额从我的银行预先填充。 我在D列填写每笔交易的类别。

这很好，但费时，因为每个类别都必须单独和手动input。

需求

根据dynamic生成和应用的规则，我希望类别能够在没有进入手动类别的行中自动填充。

我想要的输出如下所示：

 | 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 | 

正如您所看到的，我已经在列D中input了“手动”类别。无论我做了什么，我已经在列E中input了一个分类“规则”。然后，Excel将使用我的条目来自动填充列F，

逻辑很简单：

• 在我input手动类别的地方，Excel做了两件事情：

  1. 在F栏中填入我的手册类别
  2. 使用栏E中input的文本创build一个规则

• 如果Excel遇到包含我的规则中使用的文本的描述，则它会填入F列中的相关类别。

好处

这将使得简化交易清单，添加类别和相关规则变得非常简单。 没有类别的交易将在规则适用的地方自动填充，并且在规则不适用的地方留空。 已经应用规则给出错误类别的交易可以被纠正，并提供新的规则。

迄今为止我的最佳尝试

我创build了一种只使用公式的方法，但它有三个缺点：

1. 它需要创build与交易一样多的栏目。
2. 没有方便的方式列出类别和相关规则。
3. 没有办法改变规则应用的顺序。

Answer 1

介绍

正如我之前指出的，以下解决scheme是过度devise的，因为您的直接需求

它是为我的需求而devise的，它们比你在你的问题中列出的要多：

• 我正在改变银行，所以我有两个（检查）帐户和两个信用卡帐户。 我也有一些储蓄账户。 我在几本工作手册中对所有这些账号都有不同格式的电子账单。
• 您的示例语句与我收到的语句相比非常整齐。 这些是最近万事达卡声明中的一些描述，我将其整理为“组织名称，位置”的首选格式。

。

 SAINSBURY'S S/MKT MONKS CROSS Amazon *Mktplce EU-UK AMAZON.CO.UK LUX WRAP LOUGHBOROUGH SAINSBURYS PETROL MONKS CROSS 

• 像你我分类交易。
• 有些组织提前每年或每季度提前或拖欠。 我的收入每个月都不一样。 对于这些交易，我在合适的月份分配金额，以便更好地反映我真实的财务状况。

我对这些多重要求的解决scheme是为每个帐户都有一个控制程序，它知道在哪里以及每个列用于什么。 这些通用例程接受工作簿，工作表等作为参数，并执行必要的转换和添加。 这些转换和添加的核心是我称之为“规则”的工作表，它有三列：

 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 

我使用的其他规则types包括：

 "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版本”和你的账户的“需要版本”。 我假设你已经手动创build了你的账户的“需要版本”，所以你可以看到它的样子。 我已经提供了一个macros，CopyFromAcctToRule（），它可以处理您账户的“需要版本”，validation和提取“OrgCat”types的规则。 如果没有发现错误，则将提取的规则输出到工作表“规则”，并将“需要版本”转换为“scenerio版本”。 如果您还没有创build“需要版本”，我怀疑最简单的方法是创build一个像这样的部分“需要版本”：

 | 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 | | | 

也就是find第一家星巴克，并填写其分类和规则; find第一个沃尔玛并填写其分类和规则; 等等。 运行CopyFromAcctToRule（），它将在列“G”中显示错误消息，以了解您错过的不一致和组织。 对于一次性，请填写类别，但将规则留空。 重复，修复错误并运行CopyFromAcctToRule（）直到find没有错误并创build工作表“规则”。 注意：这个阶段不会添加缺less的类别; 发生在下面。

我已经提供了一个macros，FillDerivedCol（），演示了如何通过完成“scenerio版本”帐户的类别列来使用它。 如果您不想创build部分“需要版本”，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列中inputCategory。 警告：我已经超过了30,000个字符的答案。 我不得不编辑这些例程来删除诊断代码。 我希望在做这件事情时我没有引入任何错误。

我希望这是有用的。 祝你好运。

全球

这些全局常量和例程由上面提到的两个macros使用。 我把它们放在自己的模块中，但这是你的select。

 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 

提取规则并将帐户从需要转换为Scenerio风格

有关如何使用此例程的详细信息，请参阅“简介”。 一旦你为现有的交易build立了工作表“规则”，这个代码可能没有进一步的价值。 我会把它放在自己的模块中，以便在使用后可以存档和删除。 此代码假定工作表“规则”和“马特的帐户”是在同一个工作簿中。 我build议你复制你的帐户，创build工作表“规则”，然后在复制帐户上运行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 

完成您的scenerio版本帐户的类别列

这演示了我如何填写新事务的类别列。

 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 

Answer 2

我做了类似于我的信用卡帐单。 我使用VBA是因为我发现描述不一致，需要使用不同的技术对它们进行分类。

我使用的方法是有一个工作表，我称为规则包含：

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

请注意，我有一个分行的行。 这是一个很痛苦，如果你旅行很多，但没有一致的select。

在声明的D列中键入=VLOOKUP(B2,Rule!A:B,2,FALSE) ，然后复制它。

每个月新组织被分类为“＃N / A”。 我要么input一次性分类，要么将组织添加到工作表规则中。

Answer 3

这似乎是一个死胡同，但当我的银行要求我提供关于我的每月支出的细节时，我提出了同样的问题。

我不想编写VBA，所以我写了一个PowerShell脚本来为我做。 它有一个名为$Rules的数组，在其中定义了模式及其类别。 最后的模式匹配将是项目的类别。 我添加一个*结束每个模式和使用类操作符。

这有点慢，因为PowerShell访问Excel单元格很慢，并且需要几分钟时间处理我在银行对帐单导出中的1000行。 $DesColumn指存储银行对$CatColumn的列， $CatColumn是保存类别的列。

应用脚本后，您可以使用Excel PIVOTfunction创build总结数据的饼图。 记得做一个文件的备份！

  $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 =@( @("*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) 

Answer 4

I was also looking for an auto-categorization process. The options above seem really powerful but way more complicated than what I wanted.

My idea is simple: develop a set of categorization rules based on keywords. If a keyword is found on the description, the rule is applied and the category set. Not happy with the idea of using VBA or PowerShell, kept looking around and found the following post:

how-to-group-excel-items-based-on-custom-rules by John Bustos (please credit him)

John's solution uses a very simple approach:

1. Rules are defined in two columns (Keyword – Category) – if we assume that they are in columns F and 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. Then add this ARRAY formula to the cell where you want to insert the category pointing to the cell that you want to check for the rule (let's assume is cell A2):

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

   Remember to use CTRL+SHIFT+ENTER to make sure that it goes in as an array formula. If you have more rules, you will need to change the range height. Afterwards you can simply populate down the formula to all the rows that you need to categorize. Also, the categorization uses the first rule and sticks to that, so if you have two different keywords present in one of the target cells, the first keyword categorization rule will be applied. The rules have to be created manually, when a cell shows "Other" it means that there are no keywords found.

Finally, the credit goes to John Bustos, he is the one that provided the solution here . I found his solution to be simple and extremely easy to implement so I wanted to include it here because searching by "auto categorization in excel" did not come up with it immediately. I had to try other search words.