Как добавить элементы из списка B в список A, которые находятся в списке B, но отсутствуют в списке A? - PullRequest
0 голосов
/ 03 апреля 2019

У меня следующая проблема: У меня есть два списка, A и B. Список B регулярно обновляется и может содержать новые значения. Список А остается статичным. Как мне добавить новые элементы в списке B, которых нет в списке A, в список A?

Я мог бы, вероятно, сделать vlookup и вернуть пропущенные значения, но тогда я не знаю, как добавить эти пропущенные элементы в список А.

Пытаетесь понять, есть ли простой код VBA для выполнения этой операции?

***** UPDATE: ******

Итак, используя ответ ниже, я попытался написать скрипт макроса, но я получаю сообщение об ошибке во время выполнения, в котором говорится, что объект не определен при попытке добавить элементы в словарь ?:

Option Explicit
Sub AppendProfitCentres()

Dim LastRowRecon As Long
Dim LastRowSAP As Long
Dim Dict As Object
Dim MissingPC As Long
Dim i As Integer


Worksheets("Recon").Range("K6").Select
Worksheets("Recon").Range("K6", Selection.End(xlDown)).Select
LastRowRecon = Cells(Rows.Count, 11).End(xlUp).Row
Cells(LastRowRecon, 11).Select
'
''create dictionary to hold profit centres
'
'
Set Dict = CreateObject("Scripting.Dictionary")
Worksheets("Recon").Range("K6").Select
For i = 6 To LastRowRecon
'
    Dict.Add Key:=Worksheets("Recon").Range(i, 11).Value, Item:=vbNullString

Next i

'check SAP and TCM profit centres against Dictionary PC
Worksheets("SAP Data").Range("A7").Select
Worksheets("SAP Data").Range("A7", Selection.End(xlDown)).Select
LastRowSAP = Cells(Rows.Count, 1).End(xlUp).Row

For i = 7 To LastRowSAP

    If Not PC.Exists(Worksheets("SAP Data").Range(i, 1).Value) Then
     'if item doesnt exist, append to profit centres in recon tab
        MissingPC = Empty
        MissingPC = Worksheets("SAP Data").Range(i, 1).Value
        Cells(LastRowRecon, 11).Select
        ActiveCell.Offset(1).EntireRow.Insert
        ActiveCell.Value = MissingPC
    End If

 Next i

End Sub

1 Ответ

0 голосов
/ 04 апреля 2019

Я большой поклонник словарей для подобных ситуаций. Использование их уникальных ключей и метода Exists делает жизнь намного проще, чем постоянный цикл для каждого элемента, который вы хотите проверить. Просто убедитесь, что вы добавили ссылку на свой проект, чтобы вы могли получить доступ к Scripting.Dictionary из Windows.

Приведенный ниже код похож на структуру, которая поможет вам двигаться в правильном направлении. Я сделал некоторые предположения, которые я пытался указать в коде, например, список А - это столбец А, и я не учел заголовки.

Option Explicit

Public Sub CreateDictToCompare()

    Dim LastRow As Long
    Dim i As Long
    Dim Dict As Scripting.Dictionary

    'Get's the last row of column A
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With

    Set Dict = New Scripting.Dictionary

    For i = 1 To LastRow
        'Assuming List A is unique values and in Column A
        Dict.Add Key:=ActiveSheet.Range(i, 1).value, Item:=vbNullString
    Next i

    'Gets the last row of column B
    With ActiveSheet
        LastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
    End With

    For i = 1 To LastRow
            'Assuming the Values you want to compare are in column B
        If Not Dict.Exists(ActiveSheet.Range(i, 2).value) Then
            'You will only get here if the Value is not in list A.
            'You can use this space to append this value to list B
        End If
    Next i

End Sub

Надеюсь, это заставит вас двигаться в правильном направлении и удачи!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...