VBA excel，当有重复时连接单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14342939/
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
VBA excel, concatenate cells when there are duplicates
提问by oroblam
what I have here is a matrix like this
我这里有一个这样的矩阵
id value
1 A
2 B
3 C
1 D
3 E
1 F
What I need to do is to sum what I have in the value, having something along the lines of
我需要做的是总结我所拥有的价值，有一些类似的东西
id value
1 A, D, F
2 B
3 C, E
Removing the duplicated it would be nice to have but not mandatory. I tried with this formula in a third column but...
删除重复的它会很好但不是强制性的。我在第三列中尝试了这个公式，但是......
=IF(COUNTIF(A:A,A1)>1,CONCATENATE(B1,",",VLOOKUP(A1,A1:B999,2)),B1)
VLOOKUP just gives me back ONE value, it means that I cannot handle more than 1 duplicate.
VLOOKUP 只给我一个值，这意味着我不能处理超过 1 个重复项。
I did try with VBA but it's the first time for me and it's getting complicated, furthermore I cannot find a decent documentation about excel VBA. every suggestion is appreciated. Thanks
我确实尝试过 VBA，但对我来说这是第一次，而且变得越来越复杂，而且我找不到关于 excel VBA 的体面文档。每一个建议都值得赞赏。谢谢
回答by andrux
This linkwith the following VBA function may help you:
带有以下 VBA 函数的链接可以帮助您：
Function vlookupall(sSearch As String, rRange As Range, _
Optional lLookupCol As Long = 2, Optional sDel As String = ",") As String
'Vlookupall searches in first column of rRange for sSearch and returns
'corresponding values of column lLookupCol if sSearch was found. All these
'lookup values are being concatenated, delimited by sDel and returned in
'one string. If lLookupCol is negative then rRange must not have more than
'one column.
'Reverse("moc.LiborPlus.www") PB 16-Sep-2010 V0.20
Dim i As Long, sTemp As String
If lLookupCol > rRange.Columns.Count Or sSearch = "" Or _
(lLookupCol < 0 And rRange.Columns.Count > 1) Then
vlookupall = CVErr(xlErrValue)
Exit Function
End If
vlookupall = ""
For i = 1 To rRange.Rows.Count
If rRange(i, 1).Text = sSearch Then
If lLookupCol >= 0 Then
vlookupall = vlookupall & sTemp & rRange(i,lLookupCol).Text
Else
vlookupall = vlookupall & sTemp & rRange(i).Offset(0,lLookupCol).Text
End If
sTemp = sDel
End If
Next i
End Function
回答by bonCodigo
How about a pivot table :D and then copy the data to where ever you desire :D
数据透视表怎么样：D，然后将数据复制到您想要的任何位置：D
This is another way if you want to give it a try :) specially if you do not want to use a function for each row but have a button click to output the data you desire (for a large dataset).
如果您想尝试一下，这是另一种方法:) 特别是如果您不想为每一行使用一个函数，而是单击按钮来输出您想要的数据（对于大型数据集）。
Sample Code: (you may set sheets, ranges according to yours)
示例代码：（您可以根据自己的情况设置表格，范围）
Option Explicit
Sub groupConcat()
Dim dc As Object
Dim inputArray As Variant
Dim i As Integer
Set dc = CreateObject("Scripting.Dictionary")
inputArray = WorksheetFunction.Transpose(Sheets(4).Range("Q3:R8").Value)
'-- assuming you only have two columns - otherwise you need two loops
For i = LBound(inputArray, 2) To UBound(inputArray, 2)
If Not dc.Exists(inputArray(1, i)) Then
dc.Add inputArray(1, i), inputArray(2, i)
Else
dc.Item(inputArray(1, i)) = dc.Item(inputArray(1, i)) _
& "," & inputArray(2, i)
End If
Next i
'--output into sheet
Sheets(4).Range("S3").Resize(UBound(dc.keys) + 1) = _
Application.Transpose(dc.keys)
Sheets(4).Range("T3").Resize(UBound(dc.items) + 1) = _
Application.Transpose(dc.items)
Set dc = Nothing
End Sub
Output:
输出：
