VBA excel,当有重复时连接单元格

时间:2013-01-15 17:07:08

标签: excel vba

我这里有一个像这样的矩阵

    id  value  
     1   A 
     2   B
     3   C
     1   D 
     3   E
     1   F

我需要做的是总结我在价值中所拥有的东西,其中包含

的内容
    id  value  
     1   A, D, F 
     2   B
     3   C, E

删除重复的内容会很好但不是强制性的。 我尝试在第三栏中使用这个公式但是......

 =IF(COUNTIF(A:A,A1)>1,CONCATENATE(B1,",",VLOOKUP(A1,A1:B999,2)),B1)   

VLOOKUP只给了我一个值,这意味着我不能处理超过1个重复。

我确实尝试过使用VBA,但这是第一次让我变得复杂,而且我找不到关于excel VBA的体面文档。每个建议都表示赞赏。感谢

1 个答案:

答案 0 :(得分:1)

数据透视表怎么样:D然后将数据复制到你想要的地方:D

这是另一种方法,如果你想尝试一下:)特别是如果你不想为每一行使用一个函数但是点击一个按钮来输出你想要的数据(对于一个大数据集)。

示例代码:(您可以根据自己的情况设置工作表,范围)

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

输出:

enter image description here