Если Excel находит совпадение, переходите к следующему пустому месту.

Question

Привет всем: у меня есть лист Excel, такой как

ID      Name
12      Paul
12      Robert
15      John
12      George

Мне нужно изменить его, чтобы он выглядел так:

ID     Name
12     Paul     Robert     George
15     John

Я не смог найти, как его решить.Большое спасибо

Answer 1

Эта подпрограмма начинает запись данных в ячейки и ищет соответствующие данные.Если он находит совпадение, он записывает имя в той же строке.Если он не находит соответствия, он записывает его в следующую ячейку выходного столбца

Sub RewriteTable()

    Dim vaInput As Variant
    Dim i As Long
    Dim rFound As Range
    Dim rOutput As Range

    Set rOutput = Sheet1.Range("D1") 'define where to start output

    vaInput = Sheet1.Range("A1:B5") 'change to suit your date

    'write the header
    rOutput.Value = vaInput(1, 1)
    rOutput.Offset(0, 1).Value = vaInput(1, 2)

    For i = 2 To UBound(vaInput, 1)
        'find the ID in the output column
        Set rFound = rOutput.EntireColumn.Find(vaInput(i, 1), , xlValues, xlWhole)

        'if ID not found
        If rFound Is Nothing Then

            'write to next empty cell in output column
            With Sheet1.Cells(Sheet1.Rows.Count, rOutput.Column).End(xlUp).Offset(1, 0)
                .Value = vaInput(i, 1)
                .Offset(0, 1).Value = vaInput(i, 2)
            End With
        Else

            'write to next empty cell in found row
            Sheet1.Cells(rFound.Row, Sheet1.Columns.Count).End(xlToLeft).Offset(0, 1).Value = vaInput(i, 2)
        End If
    Next i

End Sub