按键列

Question

快乐的骄傲日 - 之后！

有点棘手，我一直试图解决一段时间。

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

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

变成：

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

• 一行中的最大单元格数应为11.
• 一行中的细胞数量必须是随机长度，3到11之间不超过11​​（随机化不是必需的）。
• 第一列（A）和第二列（B）是键。

下面是我试图修改的一些代码，以及一些网站和Stackoverflow的人试图获得类似的东西以供参考。

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