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

时间:2011-04-19 08:14:40

标签: excel if-statement match

大家好: 我有一张excel表,如

ID      Name
12      Paul
12      Robert
15      John
12      George

我需要将其更改为

ID     Name
12     Paul     Robert     George
15     John

未能找到解决方法。非常感谢

1 个答案:

答案 0 :(得分:0)

该子程序开始向单元格写入数据并查找匹配数据。如果找到匹配项,则会将名称写在同一行上。如果找不到匹配项,则会将其写入输出列中的下一个单元格

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