Найдите дубликаты на основе нескольких критериев и отметьте их

Question

Справочная информация:
Столбец [3] таблицы / списка объектов состоит из подписей к учетным записям.
Столбец [4] состоит из типов учетных записей.

Ограничения таблицы:
В таблице допускаются только уникальные значения в столбце [3]. Это означает, что, если «Расход по заработной плате» уже используется для типа счета «PL», его нельзя использовать для других типов счетов, кроме «PL».

Примеры:
Я проиллюстрировал два примера на скриншоте.
1. Пример: «Расходы на заработную плату» обозначены как «PL», «BS» и «Others». (желтый)
2. Пример: «Прочие расходы» относятся к «BS» и «PL». (красный)

Вариант использования / желаемое решение:
Если заголовок уже указан для указанного c Тип учетной записи и найден связанный с другим типом учетной записи. Заголовок должен получить число в конце, считая вверх.

Пример 1:
Расход на заработную плату // PL
Расход на заработную плату1 // BS
Payroll Expense2 // Прочие

Пример 2:
Прочие расходы // BS
Прочие расходы1 // PL

То, что я сделал до сих пор. Я также подумал о функции, которая сообщает алгоритму, что один «дубликат» уже найден или нет.

Подсказка: существуют только «PL», «BS» и «Others» - всего 3 типа счетов, это означает, что максимальное целое число в конце заголовка будет "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

Проблема в том, что вам нужно более одного счетчика. Вам нужен один счетчик на заголовок аккаунта. Кроме того, вы не можете просто увеличить счетчик, если линия, на которой вы находитесь, отличается от указанной c строки. Вы должны иметь возможность отслеживать каждую новую пару типа заголовка и значение счетчика в это время (для этой заголовка).

Это похоже на хорошую возможность использовать Словари сценариев , поскольку это может помочь вам достичь того, что я упомянул выше, и позволит вам сделать только один l oop над строками.

Я бы использовал один для хранения различных счетчиков и один для хранения значение соответствующего счетчика было на каждой указанной c паре типа заголовка.

Код будет выглядеть примерно так:

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 в вашем проекте.