Отношения один ко многим

Question

Надеюсь, у вас все хорошо. У меня был макрос, который, как мне показалось, работал, который должен был помочь мне привести в порядок некоторые данные в следующих строках. Я получал бы наборы данных, которые содержали бы SKU и страну в нем, и иногда это были бы дубликаты, иногда нет. Они вышли бы так:

• 123456 Франция
• 123456 Испания
• 123456 Австрия
• 123444 Испания
• 123444 Австрия
• 123444 Англия

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

• 123456 Франция, Испания, Австрия
• 123444 Испания, Австрия, Англия

Однако я получаю результаты, которые не должны отображаться. Некоторые страны, которые должны отображаться для определенных SKU, отображаются. Не хватает SKU (есть 66 уникальных SKU, но есть более 100 тыс. Строк). Я не понимаю, что не так с этим макросом. Может кто-нибудь, пожалуйста, посмотрите на меня?

Sub CondenseData()

Dim Cell    As Range
Dim Data()  As Variant
Dim Dict    As Object
Dim Key     As String
Dim index   As Long
Dim Item    As String
Dim Rng     As Range
Dim Wks     As Worksheet

    ' // Change the Worksheet and Range for your needs.
    Set Wks = ActiveSheet
    Set Rng = Wks.Range("A1", Wks.Cells(Rows.Count, "A").End(xlUp))

    ReDim Data(1 To Rng.Rows.Count, 1 To 2)

    Set Dict = CreateObject("Scripting.Dictionary")
        ' // Ignore case.
        Dict.CompareMode = vbTextCompare

        ' // Step through cells and collect the data.
        For Each Cell In Rng.Cells
            Key = Trim(Cell)            ' // Column "A" value.
            Item = Cell.Offset(0, 1)    ' // Column "B" value.

            ' // Skip empty cells.
            If Key <> "" Then
                ' // Has the SKU be added?
                If Not Dict.exists(Key) Then
                    ' // New SKU, increment the Data index.
                    index = index + 1
                    ' // Save the SKU and country on first discovery.
                    Data(index, 1) = Key
                    ' // Remove leading and trailing spaces. Capitalize the first letter of the country.
                    Data(index, 2) = Application.Proper(Trim(Item))
                    ' // Save the SKU and it's position in the Data array.
                    Dict.Add Key, index
                Else
                    ' // SKU repeat discovered, get the country.
                    index = Dict(Key)
                    ' // Exclude any repeats of the country, ignore case.
                    If InStr(1, Data(index, 2), Item, vbTextCompare) = 0 Then
                        ' // Update the country list.
                        Data(index, 2) = Data(index, 2) & "," & Item
                    End If
                End If
            End If
        Next Cell

    ' // Clear the original data and replace it with the condensed data.
    Set Rng = Rng.Resize(ColumnSize:=2)
    Rng.ClearContents
    Rng.Value = Data
   End Sub

Answer 1

Вы используете index в качестве счетчика приращений для новых SKU:

' // New SKU, increment the Data index.
index = index + 1 

, но вы также повторно используете его, чтобы найти «текущий элемент» - который сбрасывает счет ...

' // SKU repeat discovered, get the country.
index = Dict(Key)

используйте другую переменную, например indx, для второго использования.

Также вы можете переместить Application.Proper в верхнюю часть l oop:

Item = Application.Proper(Trim(Cell.Offset(0, 1)))

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