我在Excel中有一个导出的银行交易列表，我想尽可能快速简单地对其进行分类。我怀疑这可能只是使用数组公式，但VBA函数同样有用。
情景
我的电子表格标题如下所示：
| A | B | C | D |
==========================================
| Date | Description | Amount | Category |
------------------------------------------
日期，说明和金额预先填入我的银行。我在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 |
如您所见，我在D列中输入了“手动”类别。无论我在哪里，我都在列E中输入了分类“规则”。然后Excel使用我的条目自动填充F列，
逻辑很简单：
在我输入手动类别的地方，Excel会做两件事：
如果Excel遇到包含我的某个规则中使用的文字的说明，则会填充F列中的相关类别。
福利
这样可以非常简单地查看事务列表，添加类别和相关规则。没有类别的交易将在规则适用的情况下自动填充，并在规则不适用的情况下留空。可以更正已应用规则并给出错误类别的事务，并提供新规则。
到目前为止我的最佳尝试
我已经创建了一种仅使用公式的方法，但它有三个缺点：
答案 0 :(得分：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”类型的规则。如果没有发现错误，则将提取的规则输出到工作表“Rule”，并将“need version”转换为“scenerio version”。如果你还没有创建“需要版本”，我怀疑最简单的方法是创建一个像这样的部分“需要版本”：
| 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-keyword以删除分支信息，并在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
提取规则并将帐户从极品转换为Scenerio风格
有关如何使用此例程的详细信息，请参阅“简介”。为现有事务构建工作表“规则”后，此代码可能没有其他价值。我会将它放在自己的模块中，以便在使用后可以存档和删除。此代码假定工作表“Rule”和“Matt的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
完成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
答案 1 :(得分：1)
我也在寻找自动分类流程。上面的选项似乎非常强大，但比我想要的更复杂。
我的想法很简单：根据关键字开发一组分类规则。如果在描述中找到关键字，则应用规则并设置类别。对使用VBA或PowerShell的想法不满意，不停地四处寻找并找到以下帖子：
John Bustos的how-to-group-excel-items-based-on-custom-rules（请相信他）
John的解决方案采用了一种非常简单的方法：
规则分为两列（关键字 - 类别） - 如果我们假设它们位于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
然后将此ARRAY公式添加到要插入指向要检查规则的单元格的类别的单元格中（假设是单元格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中的自动分类”进行搜索并没有立即提出。我不得不尝试其他搜索词。
答案 2 :(得分：0)
我用我的信用卡对帐单做了类似的事情。我使用VBA是因为我发现描述不一致，需要不同的技术来对它们进行分类。
我使用的方法是有一个我称之为Rule的工作表：
Organisation Category
Starbucks NYC Coffee shop
Starbucks SF Coffee shop
Wal-Mart 468 Supermarket
注意，每个分支都有一行。如果你旅行很多但是没有一致性就没什么选择，这是一种痛苦。
在语句的D栏中，我输入=VLOOKUP(B2,Rule!A:B,2,FALSE)，然后将其复制下来。
每个月新组织都被归类为“#N / A”。我输入一次性分类或将组织添加到工作表规则。
答案 3 :(得分：0)
这似乎是一个死路线，但当我的银行要求我提供有关我每月支出的详细信息时，我想出了同样的问题。
我不想写VBA所以我写了一个PowerShell脚本来为我做。它有一个名为$Rules的数组，您可以在其中定义模式及其类别。匹配的最后一个模式将是项目的类别。我在每个模式的末尾添加一个*并使用-like运算符。
这有点慢，因为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 =@(
@("*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)
$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)