如果excel找到匹配项，则移至下一个空格

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