根据多个条件查找重复项并标记它们

Question

背景：
表/列表对象的列 [3] 由帐户标题组成。
列 [4] 包含帐户类型。

表格限制：
该表仅允许列 [3] 中的唯一值。这意味着如果“工资单费用”已用于“PL”帐户类型，则它不能用于“PL”以外的其他帐户类型。

示例：
我在屏幕截图中举例说明了两个示例。
1. 示例：“工资费用”来自“PL”、“BS”和“Others”。 （黄色）
2. 示例：“其他费用”来自“BS”和“PL”。 （红色）

用例/所需解决方案：
如果已为特定帐户类型制作了标题并且发现与另一个帐户类型相关联，则标题应在末尾有一个数字，向上计数。

示例 1：
工资支出 // PL
工资支出1 // BS
工资支出2 // 其他

示例 2：
其他费用 // BS
其他费用1 // PL

到目前为止我做了什么。我还想到了一个函数，它告诉算法是否已经找到一个“重复”。

提示：只有“PL”、“BS”和“Others”——总共 3 种帐户类型，这意味着 Caption 末尾的最大整数为“2”。

Sub checkDuplicateCaptionsWithinAccountType()
    Call declareVariables

    Dim sSearchCaption As String
    Dim sSearchAccountType As String
    counter = 0
    For n = 1 To 2
        counter = counter + 1
        With LObjAccounts
            For i = 1 To .DataBodyRange.Rows.Count
                sSearchCaption = .DataBodyRange.Cells(i, 3)
                sSearchAccountType = .DataBodyRange.Cells(i, 4)
                For j = 1 To .DataBodyRange.Rows.Count
                    If UCase(sSearchCaption) = UCase(.DataBodyRange.Cells(j, 3)) Then
                        If UCase(sSearchAccountType) <> UCase(.DataBodyRange.Cells(j, 4)) Then
                            .DataBodyRange.Cells(j, 3) = .DataBodyRange.Cells(j, 3) & counter
                        End If
                    End If
                Next j
            Next i
        End With
    Next n
    MsgBox "done."
End Sub

Function isAlreadyFound(ByVal sFind As String, ByRef arr) As Boolean

End Function

Answer 1

这里的问题是您需要多个计数器。每个帐户标题需要一个计数器。此外，当您所在的线路与特定线路不同时，您不能只增加计数器。您需要能够跟踪每个新的字幕类型对以及当时计数器的值（针对该字幕）。

这似乎是一个使用Scripting Dictionaries 的好机会，因为它可以帮助您实现我上面提到的目标，并且只允许您在行上执行一次循环。

我会使用一个来存储不同的计数器，一个来存储每个特定标题类型对对应的计数器的值。

代码如下所示：

Sub checkDuplicateCaptionsWithinAccountType()
    Call declareVariables

    Dim sSearchCaption As String
    Dim sSearchAccountType As String

    Dim Counters As Object 'Or: Scripting.Dictionary
    Set Counters = CreateObject("Scripting.Dictionary") 'Or: new Scripting.Dictionary

    Dim Pairs As Object 'Or: Scripting.Dictionary
    Set Pairs = CreateObject("Scripting.Dictionary") 'Or: new Scripting.Dictionary

    Const Delimiter As String = "-"

    With LObjAccounts
        For i = 1 To .DataBodyRange.Rows.Count
            sSearchCaption = .DataBodyRange.Cells(i, 3)
            sSearchAccountType = .DataBodyRange.Cells(i, 4)

            If Counters.Exists(sSearchCaption) Then 'If we have already seen this account caption

                If Pairs.Exists(sSearchCaption & Delimiter & sSearchAccountType) Then 'If we have seen this caption-type pair

                    'Do nothing since we don't increase the counter if we've already seen this pair

                Else

                    'We increase the counter for that caption since we just found a new caption-type pair
                    Counters.Item(sSearchCaption) = Counters.Item(sSearchCaption) + 1

                    'Save the counter number for this specific pair
                    Pairs.Add sSearchCaption & Delimiter & sSearchAccountType, Counters.Item(sSearchCaption)

                End If

            Else
                'We have'nt seen this caption so we create a new counter starting at zero
                Counters.Add sSearchCaption, 0

                'Save the counter number (zero) for this specific pair
                Pairs.Add sSearchCaption & Delimiter & sSearchAccountType, 0

            End If

            If Pairs.Item(sSearchCaption & Delimiter & sSearchAccountType) > 0 Then
                .DataBodyRange.Cells(i, 3) = .DataBodyRange.Cells(i, 3) & Pairs.Item(sSearchCaption & Delimiter & sSearchAccountType)
            End If

        Next i
    End With

    MsgBox "done."
End Sub

请注意，我使用后期绑定方法来声明字典，因为我不知道您的项目中是否引用了 Microsoft Scripting Runtime 库。