Excel VBA - 根据公共属性组合行。合并相邻单元格并将数据列表到该单元格中

Question

我遇到了与此类似的问题，需要一些附加功能。
Excel VBA - 合并一个单元格中具有重复值的行并合并其他单元格中的值

| attribute | description  |
|-----------|--------------|
| type 1    | type 1 arms  |
| type 1    | type 1 legs  |
| type 1    | type 1 body  |
| type 2    | type 2 head  |
| type 2    | type 2 wings |
| type 2    | type 2 tail  |

我可以使用下面链接的方法，但我不知道如何合并相邻单元格，然后执行将数据放入新合并单元格的操作。
Excel VBA - 合并一个单元格中具有重复值的行并合并其他单元格中的值

Answer 1

使用 Dict 对象获取合并的 Range 和值。

Sub Demo()
    Dim objDic As Object, objDicVal As Object, rngData As Range
    Dim i As Long, sKey, arrData
    Set objDic = CreateObject("scripting.dictionary")
    Set objDicVal = CreateObject("scripting.dictionary")
    Set rngData = Range("A1").CurrentRegion
    rngData.Sort key1:=rngData.Cells(1), Header:=xlYes
    arrData = rngData.Value
    For i = LBound(arrData) + 1 To UBound(arrData)
        sKey = arrData(i, 1)
        If objDic.exists(sKey) Then
            Set objDic(sKey) = Union(objDic(sKey), Cells(i, 3))
            objDicVal(sKey) = objDicVal(sKey) & Chr(10) & Cells(i, 2)
        Else
            Set objDic(sKey) = Cells(i, 3)
            objDicVal(sKey) = Cells(i, 2)
        End If
    Next i
    For Each sKey In objDic
        If objDic(sKey).Cells.Count > 1 Then
            objDic(sKey).Merge
            objDic(sKey).Cells(1).Value = objDicVal(sKey)
        End If
    Next
End Sub

微软文档：

范围.合并方法（Excel）

Range.CurrentRegion 属性 (Excel)

字典对象