Align identical data in two columns while preservi

2019-09-19 01:33发布

问题:

I have a large amount of data spread throughout 3 columns on a worksheet in excel. I want to match identical values in columns A & B while keeping values associated with column B inline with their respective B components. Here is an example:

What I have-

    A   B   C
1   a   g   '
2   b   h   *
3   c   a   ?
4   d   e   $
5   e   b   /
6   f   j   )
7   g   c   #
8   h   d   @
9   i
10  j

What I am looking to achieve:

    A   B   C
1   a   a   ?
2   b   b   /
3   c   c   #
4   d   d   @
5   e   e   $
6   f
7   g   g   '
8   h   h   *
9   i
10  j   j   )

I found this code, but it doesn't also carry over the 3rd column values.

Sub Macro1()
    Dim rng1 As Range
    Set rng1 = Range([a1], Cells(Rows.Count, "A").End(xlUp))
    rng1.Offset(0, 1).Columns.Insert
    With rng1.Offset(0, 1)
        .FormulaR1C1 = _
        "=IF(ISNA(MATCH(RC[-1],C[1],0)),"""",INDEX(C[1],MATCH(RC[-1],C[1],0)))"
        .Value = .Value
    End With
End Sub

Any help would be greatly appreciated! Thanks

回答1:

You will have to store the values in memory (a variant array seems appropriate), then clear the values and work through A1:A10 looking for matches to the first rank of the array.

Sub aaMacro1()
    Dim i As Long, j As Long, lr As Long, vVALs As Variant
    With ActiveSheet
        lr = .Cells(Rows.Count, 1).End(xlUp).Row
        vVALs = Range("B1:C" & lr)
        Range("B1:C" & lr).ClearContents
        For i = 1 To lr
            For j = 1 To UBound(vVALs, 1)
                If vVALs(j, 1) = .Cells(i, 1).Value Then
                    .Cells(i, 2).Resize(1, 2) = Application.Index(vVALs, j)
                    Exit For
                End If
            Next j
        Next i
    End With
End Sub

It would probably be best if you tested that on a copy of your data as it does remove the values from B1:C10 before returning them.