Ошибка времени выполнения '1004' Ошибка приложения или объекта '

Question

У меня есть макрос, который должен помочь мне трансформировать отношения многие ко многим в отношения один ко многим.

Например, если у меня есть SKU и ордер в определенную страну, присоединенный к этой SKU, а затем повторение этой же комбинации country/SKU, я хочу создать строка за строкой, которая содержит ПРОСТО * SKU, а затем в соседней ячейке список значений всех стран, в которых она была продана, через запятую. Я получаю Ошибка приложения во время выполнения в это. Я не знаю почему.

Может кто-нибудь взглянуть на это и помочь мне, когда у него есть момент?

Я добавил пару звездочек и ошибок, указывающих где возникает ошибка.

Sub SteveOranjin()
    Dim Cl As Range
    '''This is all in VBA for EXCEL:
    With CreateObject("scripting.dictionary")
        For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
            If Not .exists(Cl.Value) Then
                .Add Cl.Value, Cl.Offset(, 1).Value
            Else
                .Item(Cl.Value) = .Item(Cl.Value) & ", " & Cl.Offset(, 1).Value
            End If
        Next Cl
        Range("F2").Resize(.Count, 2).Value = Application.Transpose(Array(.keys, .items))  ' ***[error here.]***
    End With
End Sub

Answer 1

Это то, что вы пытаетесь?

Option Explicit

Sub SteveOranjin()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim dict As Object
    Dim arKey, arItm, arFinal

    Set ws = Sheet1 '<~~ Change this to the relevant sheet   
    Set dict = CreateObject("scripting.dictionary")

    With ws
        .Columns("A:B").RemoveDuplicates Columns:=Array(1, 2)

        lRow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To lRow
            If Not dict.exists(.Range("A" & i).Value) Then
                dict.Add .Range("A" & i).Value, .Range("B" & i).Value
            Else
                dict.Item(.Range("A" & i).Value) = dict.Item(.Range("A" & i).Value) & _
                                                   ", " & .Range("B" & i).Value
            End If
        Next i
    End With

    arKey = dict.Keys: arItm = dict.Items

    ReDim arFinal(LBound(arKey) To UBound(arKey), 0 To 1)

    For i = LBound(arKey) To UBound(arKey)
        arFinal(i, 0) = arKey(i): arFinal(i, 1) = arItm(i)
    Next i

    Range("F2").Resize(UBound(arFinal) + 1, 2) = arFinal
End Sub

в действии