通过键列将列按行sorting（具有随机的长度）

快乐的骄傲日后！

有点棘手，我一直在尝试通过一段时间。

我试图将三列分成3和11个单元格之间的随机长度行，其中列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 

参考文献：

• 一旦达到限制，将单元格移动到新行
• Excel选项卡在一定数量的列之后换行
• 拆分Excel列和复制数据到新行

谢谢你的帮助，Giles。

Answer 1

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

对于数据收集，集合词典是一个好方法，因为它可以让你根据你的两个列键收集数据。 由于您不知道需要存储多less个值，因此Collection是一个好的容器（尽pipeString的数组也可以）。 数据收集function看起来像这样：

 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脚本运行时的引用。 还要注意，这不需要对input进行sorting。

一旦有了这些数据，写出来就相当简单了。 只需遍历关键字并根据您需要的任何参数编写集合：

 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