按键列将列排序为行（具有随机长度）

Question

骄傲节快乐！

有点棘手，我已经尝试了一段时间。

我正在尝试将三列排序为 3 到 11 个单元格之间的随机长度行，其中 A 列和 B 列本质上是键。

我想要实现的一个简单示例是：

变成了：

需要注意的一些关键事项：

一行中的最大单元格数应为 11。
一行中的单元格数量必须是随机长度，介于 3 到 11 之间，永远不会超过 11（随机化不是必需的）。
第一 (A) 和第二 (B) 列是键。

下面是一些我一直在尝试修改的代码，以及一些网站和 Whosebug 的人们试图实现类似的事情以供参考。

Sub mergeCategoryValues()
    Dim lngRow As Long

    With ActiveSheet
        Dim columnToMatch As Integer: columnToMatch = 2
        Dim columnToConcatenate As Integer: columnToConcatenate = 1

        lngRow = .Cells(65536, columnToMatch).End(xlUp).Row
        .Cells(columnToMatch).CurrentRegion.Sort key1:=.Cells(columnToMatch), Header:=xlYes

        Do
            If .Cells(lngRow, columnToMatch) = .Cells(lngRow - 1, columnToMatch) Then
                .Cells(lngRow - 1, columnToConcatenate) = .Cells(lngRow - 1, columnToConcatenate) & "; " & .Cells(lngRow, columnToConcatenate)
            .Rows(lngRow).Delete
            End If

            lngRow = lngRow - 1
        Loop Until lngRow = 1
    End With
End Sub

参考文献：

Move Cells into New Row Once Limit is Reached
Excel tab to new line after certain amount of columns
Split Excel Column and Copy Data into New Row

Answer 1

我可能会将此作为一个两步过程来处理，而不是尝试重新安排工作表。首先将所有数据收集到适当的结构中，然后清除工作表并将结果写回它。

对于数据收集，集合字典是一个很好的方法，因为它允许您根据两个列键收集数据。由于您不知道需要存储多少个值，因此 Collection 是一个很好的容器（尽管 String 数组也可以）。数据收集函数看起来像这样：

Private Function GatherData(sheet As Worksheet) As Scripting.Dictionary
    Dim results As New Scripting.Dictionary
    With sheet
        Dim key As String
        Dim currentRow As Long
        For currentRow = 2 To .Cells(.Rows.Count, 2).End(xlUp).Row
            key = .Cells(currentRow, 1) & "|" & .Cells(currentRow, 2)
            If Not results.Exists(key) Then results.Add key, New Collection
            results(key).Add .Cells(currentRow, 3).Value
        Next currentRow
    End With
    Set GatherData = results
End Function

您需要添加对 Microsoft Scripting Runtime 的引用。另请注意，这不需要对输入进行排序。

一旦你有了数据，写出来就相当容易了。只需遍历键并根据您需要的任何参数编写集合：

Private Sub WriteResults(sheet As Worksheet, data As Scripting.Dictionary)
    Dim currentRow As Long
    Dim currentCol As Long
    Dim index As Long
    Dim key As Variant
    Dim id() As String
    Dim values As Collection

    currentRow = 2
    For Each key In data.Keys
        id = Split(key, "|")
        Set values = data(key)
        currentCol = 3
        With sheet
            .Cells(currentRow, 1) = id(0)
            .Cells(currentRow, 2) = id(1)
            For index = 1 To values.Count
                .Cells(currentRow, currentCol) = values(index)
                currentCol = currentCol + 1
                If currentCol > 11 And index < values.Count Then
                    currentRow = currentRow + 1
                    currentCol = 3
                    .Cells(currentRow, 1) = id(0)
                    .Cells(currentRow, 2) = id(1)
                End If
            Next index
            currentRow = currentRow + 1
        End With
    Next key
End Sub

请注意，这不会随机化名称集合或每行中的数字（如果超过 9 个），但是将内部循环提取到另一个 Sub 中来执行此操作相当容易。

像这样把它们放在一起：

Sub mergeCategoryValues()
    Dim target As Worksheet
    Dim data As Scripting.Dictionary

    Set target = ActiveSheet
    Set data = GatherData(target)
    target.UsedRange.ClearContents
    WriteResults target, data
End Sub

按键列将列排序为行（具有随机长度）

Sorting columns into rows (with a random length) by key columns

excel

vba

excel-formula

excel-2010