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

我希望在其旁边的单元格中包含一个唯一的销售人员及其销售物品的列表，但我会得到一种Pascal的三角形显示。也许我需要另一个内循环。不知道如何进行。请任何帮助将不胜感激。预先谢谢你。

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

如何为每个循环在vba中有条件地将子范围连接成不同的字符串

1 个答案: