如何在Excel中将列上的重复值设为1行

Question

A	B	C
S.没有	账户	产品
1	00125000021lifAAAQ	01t25000008AUatAAG
2	00125000021lifBAAQ	01t25000008AUbIAAW
3	00125000021lifBAAQ	01t25000008AUkJAAW

我有 3 列。如果 B 列有重复值。然后，C 列上的相应值应作为新单元格放置在下一列中。 例如：上表帐户列 B2 和 B3 相同。然后我想要 D2 单元格上的 C3。

A	B	C	D
S.没有	账户	产品
1	00125000021lifAAAQ	01t25000008AUatAAG
2	00125000021lifBAAQ	01t25000008AUbIAAW	01t25000008AUkJAAW

如何在 Excel 中执行此操作。请帮忙。预先感谢。

我尝试使用谷歌中可用的公式。我是新人，追求卓越。我想在excel中这样显示 |A |B| C| D| |---|---|---|---| |S.no |账户|产品 | |1 |00125000021lifAAAQ |01t25000008AUatAAG | 2 |00125000021lifBAAQ |01t25000008AUbIAAW| 01t25000008AUkJAAW|

Answer 1

• objDic

  收集每个帐户的所有产品

• objDicCnt

  获取每个账户的产品数量

Option Explicit
Sub Demo()
    Dim objDic As Object, objDicCnt As Object, rngData As Range
    Dim i As Long, sKey, arrData, arrRes, iR As Long, aTxt
    Set objDic = CreateObject("scripting.dictionary")
    Set objDicCnt = CreateObject("scripting.dictionary")
    Dim oSht As Worksheet
    Set oSht = Sheets("Sheet1")
    Set rngData = oSht.Range("A1").CurrentRegion
    arrData = rngData.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 2)
        If objDic.exists(sKey) Then
            objDic(sKey) = objDic(sKey) & "|" & arrData(i, 3)
            objDicCnt(sKey) = objDicCnt(sKey) + 1
        Else
            objDic(sKey) = arrData(i, 3)
            objDicCnt(sKey) = 1
        End If
    Next i
    Dim ColCnt As Long
    For Each sKey In objDicCnt.Keys
        If objDicCnt(sKey) > ColCnt Then ColCnt = objDicCnt(sKey)
    Next
    ReDim arrRes(1 To objDic.Count, 1 To ColCnt + 2)
    Sheets.Add
    oSht.Rows(1).Copy ActiveSheet.Range("A1")
    For Each sKey In objDic.Keys
        aTxt = Split(objDic(sKey), "|")
        iR = iR + 1
        arrRes(iR, 1) = iR
        arrRes(iR, 2) = sKey
        For i = LBound(aTxt) To UBound(aTxt)
            arrRes(iR, i + 3) = aTxt(i)
        Next
        If objDic(sKey) > ColCnt Then ColCnt = objDicCnt(sKey)
    Next
    Range("A2").Resize(iR, ColCnt + 2) = arrRes
    ActiveSheet.UsedRange.EntireColumn.AutoFit
    Set objDic = Nothing
End Sub