excel - 在MS Excel中合并行

我在Excel中有以下几行（行），格式如下：


我需要将其转换为以下形式：

我不是MS Excel的好用户，我使用的是法语版本。

谢谢

最佳答案

试试这个

Option Explicit
Public Sub MergeRows()
    Dim rng As Range
    Dim dict As Object
    Dim tmp As Variant
    Dim i As Long, j As Long
    Dim c, key

    Set dict = CreateObject("Scripting.dictionary")
    dict.CompareMode = vbTextCompare
    ' Change this to where your source data is
    With Sheet17
        Set rng = .Range(.Cells(2, 10), .Cells(.Cells(.Rows.Count, 10).End(xlUp).Row, 10))
    End With

    For Each c In rng
        If Not dict.exists(c.Value2) Then
            ReDim tmp(1 To 3)
            dict.Add key:=c.Value2, Item:=tmp
        End If
        j = 1
        tmp = dict(c.Value2)
        Do
            If Not c.Offset(0, j).Value2 = vbNullString Then tmp(j) = c.Offset(0, j).Value2
            j = j + 1
        Loop Until j > UBound(tmp)
        dict(c.Value2) = tmp
    Next c
    ' Change this to where you want your output
    With Sheet17.Range("A2")
        i = 0
        For Each key In dict.keys
            .Offset(i, 0).Value2 = key
            .Offset(i, 1).Resize(, UBound(dict(key))) = dict(key)
            i = i + 1
        Next key
    End With
End Sub