Как условно объединить поддиапазоны в разные строки в vba для каждого цикла

Question

У меня есть список продавцов и товаров, которые они продают. 1 продавец продает n товаров. Мне нужно отобразить сводный список из 1 продавца в строке и объединить все товары, которые они продают, в следующую ячейку той же строки, разделенные запятыми.

Сначала я создаю диапазон, содержащий уникальных продавцов, Затем переберите диапазон, содержащий продавцов с каждой петлей, Для каждого вхождения продаж в этом диапазоне я объединяю проданный товар во временную переменную

Это мой код:

i = 2 ' Depending on my reports sheet
For Each salesPerson In salesPersons
    ActiveWorkbook.Worksheets(1).range(salesPerson.Offset(0, 1).Address).Copy_ActiveWorkbook.Worksheets(2).range("F" & i)
    items = items & "," & ActiveWorkbook.Worksheets(1).range(salesPerson.Offset(0, 1).Address)
    ActiveWorkbook.Worksheets(2).range("G" & i).Value = items
    i = i + 1
Next salesPerson

* +1012 *

Я ожидаю, что список уникальных продавцов и предметов, которые они продают, будут объединены в ячейке рядом с ним, но я получаю своеобразный показ треугольника Паскаля. Может быть, мне нужен еще один внутренний цикл. Не уверен, как поступить. Пожалуйста, любая помощь будет очень ценится. Заранее спасибо.

Answer 1

РЕДАКТИРОВАТЬ (на основании дополнительной информации в комментариях)

У вас есть несколько вариантов, когда вы хотите добавить более одного элемента в элементе Value словаря. Вы можете использовать пользовательские объекты, массивы или вложенные словари. Я склонен использовать вложенные словари, потому что они дают JSON-ощущение моей коллекции в памяти. Кроме того, у них нет дополнительной работы и затрат на создание класса, и они не требуют, чтобы мы запоминали позиции, как это сделал бы массив.

См. Приведенный ниже код и протестируйте его в своем приложении. Важное примечание: я заметил, что у каждого продавца был только один город, поэтому я не вносил изменений в поле города после его заполнения. Если это не так, вам придется изменить код для удовлетворения потребностей.

Sub ConcatenateItems()
    Dim salesPersons As Range
    Dim slsPerson As Range
    Dim oDictionary As Object
    Dim tmpItems As String
    Dim oTmpDict As Object

    'The range holding the salespeople (change this to your range)
    Set salesPersons = Range("A2:A18")

    'Dictionary object to hold unique salesperson names and their list of items
    Set oDictionary = CreateObject("Scripting.Dictionary")

    For Each slsPerson In salesPersons
        'Check if we've already added this salesperson
        If oDictionary.exists(slsPerson.Value) Then
            'Get the currently stored items string
            tmpItems = oDictionary(slsPerson.Value)("Items")

            ''''''''''''''''''''
            ' IMPORTANT NOTE:
            ' In the example, each salesperson only had one city,
            ' so I do not update the city with each iteration.
            ' Instead, I only update the items and assume the city
            ' is correct from a prior iteration.
            ''''''''''''''''''''

            'Update the items string with the new item
            tmpItems = tmpItems & ", " & slsPerson.Offset(, 1).Value

            'Replace the items string with the update version
            oDictionary(slsPerson.Value)("Items") = tmpItems
        Else
            'Salesperson not yet added

            'Create a temp dictionary with two keys, 'Items' and 'City'
            Set oTmpDict = CreateObject("Scripting.Dictionary")
            oTmpDict.Add "Items", slsPerson.Offset(, 1).Value
            oTmpDict.Add "City", slsPerson.Offset(, 2).Value

            oDictionary.Add slsPerson.Value, oTmpDict
        End If
    Next slsPerson

    'Once the dictionary has been fully populated in memory, place it wherever you'd like

    Dim rngDestination As Range

    Set rngDestination = Sheet2.Range("A1")

    For Each oKey In oDictionary
        'Put salesperson name in rngDestination
        rngDestination.Value = oKey

        'Put items list in the cell to the left
        rngDestination.Offset(, 1).Value = oDictionary(oKey)("Items")
        rngDestination.Offset(, 2).Value = oDictionary(oKey)("City")

        'Set rngDestination to the next cell down for the following iteration
        Set rngDestination = rngDestination.Offset(1)
    Next oKey

End Sub

---

Когда дело доходит до таких манипуляций, я склонен делать их в памяти, а затем сразу же помещать проанализированную информацию в электронную таблицу. В этом случае, поскольку вы имеете дело с уникальными именами продавцов (я предполагаю, что они уникальны для группировки), я использую объект словаря. Попробуйте следовать коду и адаптировать его к своим потребностям, и напишите, если у вас есть какие-либо вопросы или вопросы.

Sub ConcatenateItems()
    Dim salesPersons As Range
    Dim slsPerson As Range
    Dim oDictionary As Object
    Dim tmpItems As String


    'The range holding the salespeople (change this to your range)
    Set salesPersons = Range("A2:A17")

    'Dictionary object to hold unique salesperson names and their list of items
    Set oDictionary = CreateObject("Scripting.Dictionary")

    For Each slsPerson In salesPersons
        'Check if we've already added this salesperson
        If oDictionary.exists(slsPerson.Value) Then
            'Get the currently stored items string
            tmpItems = oDictionary(slsPerson.Value)

            'Update the items string with the new item
            tmpItems = tmpItems & ", " & slsPerson.Offset(, 1).Value

            'Replace the items string with the update version
            oDictionary(slsPerson.Value) = tmpItems
        Else
            'Salesperson not yet added
            oDictionary.Add slsPerson.Value, slsPerson.Offset(, 1).Value
        End If
    Next slsPerson

    'Once the dictionary has been fully populated in memory, place it wherever you'd like

    Dim rngDestination As Range

    Set rngDestination = Sheet2.Range("A1")

    For Each oKey In oDictionary
        'Put salesperson name in rngDestination
        rngDestination.Value = oKey

        'Put items list in the cell to the left
        rngDestination.Offset(, 1).Value = oDictionary(oKey)

        'Set rngDestination to the next cell down for the following iteration
        Set rngDestination = rngDestination.Offset(1)
    Next oKey

End Sub