vba 在 Excel 中将具有相同值的多行合并为一加多...
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5942588/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Combine multiple rows with same value into one plus more... in Excel
提问by Dmitry
I have a list of product ids and order numbers. Each order number can have multiple product ids(since a person can buy more than one item). My goal is to combine each order number and product ids associated with it into one row. If there are more than one product id for each order then separate them my comma. Please see illustration below. I would like to avoid using manual approach as I have around 13000 rows. Please advise. Thanks.
我有一个产品 ID 和订单号的列表。每个订单号可以有多个产品 ID（因为一个人可以购买不止一件商品）。我的目标是将每个订单号和与其关联的产品 ID 合并为一行。如果每个订单有多个产品 ID，则用逗号将它们分开。请参见下图。我想避免使用手动方法，因为我有大约 13000 行。请指教。谢谢。
Covert this: order product 158 866 161 960 163 976 163 884 164 1010 173 834 174 981 177 935 177 832 177 934 to this: order product 158 866 161 960 163 976,884 164 1010 173 834 174 981 177 935,832,934
采纳答案by chris neilsen
The link given by @Nick provides a good non-VBA solution for where you want to keep the original data intact.
@Nick 给出的链接提供了一个很好的非 VBA 解决方案，用于您希望保持原始数据完整的地方。
If you want to modify the data to leave only the merged rows, then a VBA solution will be required.
如果您想修改数据以仅保留合并的行，则需要 VBA 解决方案。
Here's a macro that will do the merging.
这是一个将进行合并的宏。
NOTES:
笔记：
It assumes there is no other useful data on the sheet. If there is it will be deleted and or overwritten.
It works on the active sheet
It does the merging in memory variant arrays to provide resonable speed. Looping over the cells/rows would produce simpler code, but would run much slower
它假定工作表上没有其他有用的数据。如果存在，它将被删除或覆盖。
它适用于活动工作表
它合并内存变量数组以提供合理的速度。循环单元格/行会产生更简单的代码，但运行速度会慢得多
.
.
Sub MergeRows()
Dim rng As Range
Dim vSrc As Variant
Dim vDst() As Variant
Dim i As Long, j As Long
' Assumes data starts at cell A2 and extends down with no empty cells
Set rng = Range([A2], [A2].End(xlDown))
' Count unique values in column A
j = Application.Evaluate("SUM(IF(FREQUENCY(" _
& rng.Address & "," & rng.Address & ")>0,1))")
ReDim vDst(1 To j, 1 To 2)
j = 1
' Get original data into an array
vSrc = rng.Resize(, 2)
' Create new array, one row for each unique value in column A
vDst(1, 1) = vSrc(1, 1)
vDst(1, 2) = "'" & vSrc(1, 2)
For i = 2 To UBound(vSrc, 1)
If vSrc(i - 1, 1) = vSrc(i, 1) Then
vDst(j, 2) = vDst(j, 2) & "," & vSrc(i, 2)
Else
j = j + 1
vDst(j, 1) = vSrc(i, 1)
vDst(j, 2) = "'" & vSrc(i, 2)
End If
Next
' Remove old data
rng.EntireRow.Delete
' Put new data in sheet
Set rng = [A2].Resize(j, 2)
rng = vDst
End Sub
回答by Excellll
If you want to keep the original data and summarize it somewhere else, you can use a method I detailed in a previous post. This would require you to make a list of all unique order numbers somewhere, and then use the CCARRAY UDF in the adjacent column. If the original data is on Sheet1, and the new summary list is on Sheet2, you would use the following formula to get the product information for the order number in A2 on Sheet2:
如果您想保留原始数据并在其他地方汇总，您可以使用我在上一篇文章中详述的方法。这将要求您在某处列出所有唯一订单号，然后在相邻列中使用 CCARRAY UDF。如果原始数据在 Sheet1 上，而新的汇总列表在 Sheet2 上，您将使用以下公式获取 Sheet2 上 A2 中订单号的产品信息：
{=CCARRAY(IF(Sheet1!$A:$A000=$A2,Sheet1!$B:$B000),",")}
Just fill this formula down, and you're done.
只需填写这个公式，你就完成了。
To get the list of unique order numbers on Sheet2, just do something like copy the list of orders from Sheet1 to Sheet2, and then Remove Duplicates on Sheet2.
要获取 Sheet2 上唯一订单号的列表，只需执行一些操作，例如将订单列表从 Sheet1 复制到 Sheet2，然后在 Sheet2 上删除重复项。
