如何将列表B中但不在列表A中的项目从列表B追加到列表A?

时间:2019-04-03 15:53:51

标签: excel vba

我有以下问题: 我有两个列表,A和B。列表B会定期更新,并且可能包含新值。列表A保持静态。如何将列表B中当前不在列表A中的新项目附加到列表A中?

我可能可以执行vlookup并返回缺少的值,但是我不知道如何将那些缺少的项附加到列表A中。

努力了解是否有简单的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 :(得分:0)

在这种情况下,我非常喜欢Dictionary。与不断循环查找您要检查的每个项目相比,利用它们的独特键和Exists方法使生活变得容易得多。只要确保将引用添加到项目中,就可以从Windows访问Scripting.Dictionary。

下面的代码就像一个框架,它将使您朝正确的方向前进。我确实做了一些假设,试图在代码中指出,例如列表A是列A,并且没有考虑标题。

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

希望这能使您朝着正确的方向前进,并祝您好运!