0

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

    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 的像样的文档。每一个建议都值得赞赏。谢谢

4

2 回答 2

3

带有以下 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
于 2013-01-15T17:23:42.197 回答
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

输出：

在此处输入图像描述

于 2013-01-15T17:29:06.673 回答