Question

此宏比较两个不同工作表的两列，并显示新的和已删除的值。

不幸的是，我不知道如何将d1和d3中的项目插入到活动工作表中（它不能正常工作，如下所示）。该部分在代码中突出显示。

有人可以帮忙吗？

Sub test()
    Dim e As Range
    Dim shA As Worksheet
    Dim shB As Worksheet

    'Objekte festlegen
    Set d1 = CreateObject("scripting.dictionary")
    Set d2 = CreateObject("scripting.dictionary")
    Set d3 = CreateObject("scripting.dictionary")
    Set shA = Worksheets(Format(Date, "dd.mm.yyyy"))
    Set shB = Worksheets(ActiveSheet.Index - 1)

    'Füge ICM Nummern des alten Tabellenblattes Objekten zu
    With shB
        For Each e In .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(3).Row)
            d1(e) = True
            d2(e) = True
        Next e
    End With

    'Neue und alte ICM Nummern bestimmen
    With shA
        For Each e In .Cells(2, 1).Resize(.Cells(.Rows.Count, 1).End(3).Row)
            If (d2(e)) * (d1.exists(e)) Then d1.Remove e
            If Not d2(e) Then d3(e) = True
    Next e

    'Objekte transponieren und einfügen in aktuelles Tabellenblatte unter ICM Abzug

    On Error Resume Next
        .Cells(2, 10).Resize(d1.Count) = .Application.Transpose(d1.keys)
        .Cells(2, 11).Resize(d3.Count) = .Application.Transpose(d3.keys)
    On Error GoTo 0
    End With

End Sub

Answer 1

循环不是总是那么糟糕，它将花费时间来获取2 Key个对象的Dictionary。

Dim Key As Variant

With shA
    i = 2
    For Each Key In d1.keys
        .Cells(i, 10).Value = Key       
        i = i + 1
    Next Key

    i = 2
    For Each Key In d3.keys
        .Cells(i, 1).Value = Key        
        i = i + 1
    Next Key
End With

如何将范围项的值插入工作表？

1 个答案: