一对多关系

Question

希望你一切都好。我有一个我认为正在工作的宏，它应该可以帮助我清理并根据以下几行组织一些数据。我会收到包含 SKU 和国家/地区的数据集，有时这些是重复的，有时不是。他们会这样出来：

• 123456 法国
• 123456 西班牙
• 123456 奥地利
• 123444 西班牙
• 123444 奥地利
• 123444 英格兰

最终产品应该是这样出来的。

• 123456 法国、西班牙、奥地利
• 123444 西班牙、奥地利、英国

但是，我得到了不应该显示的结果。一些应该显示某些 SKU 的国家/地区正在显示。没有足够的 SKU 出现（有 66 个独特的 SKU，但有超过 100k 行。）我不清楚这个宏有什么问题。有人可以帮我看看吗？

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 移动到循环的顶部：

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

您目前仅在添加新字典项时使用它，而不是用于现有 SKU 行...