Question

我的数据在很多专栏中都有所传播。其中，列A和列B具有相同的名称（重复），而列C到Q是与列B相关的值。我希望将列B与列A对齐，同时保留后续值。

注意：我的问题与此问题非常相似“Align identical data in two columns while preserving values in the 3rd in excel”

但在我的情况下，我想保留更多后续列（从C到Q）。我玩@Jeeped在该帖子中作为解决方案提供的代码但失败了。

我可以在这方面得到任何帮助，

我试过以下代码： 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

我尝试将范围（“B1：C”和lr）更改为范围（“B1：Q”和lr），但它没有用。之后，我将.Resize（1,2）更改为.Resize（1,3），并复制了两个后续行，但是当我使用.Resize（1,4）插入代码时，无效。

希望这篇经过编辑的帖子有助于回答我的问题。

最好的

Answer 1

根据原始链接中的代码，应该使用任意数量的列...

Option Explicit
Option Base 1
Sub aaMacro1()

    Dim i As Long, j As Long, k As Long
    Dim nRows As Long, nCols As Long
    Dim myRng As Range
    Dim vVALs() As Variant

    With ActiveSheet
        nRows = .Cells(Rows.Count, 1).End(xlUp).Row
        nCols = .Cells(1, Columns.Count).End(xlToLeft).Column
        Set myRng = .Range(.Cells(2, 2), .Cells(nRows, nCols))
    End With
    nRows = nRows - 1
    nCols = nCols - 1

    vVALs = myRng.Value
    myRng.ClearContents
    For i = 1 To nRows
        For j = 1 To nRows
            If vVALs(j, 1) = ActiveSheet.Cells(i + 1, 1).Value Then
                For k = 1 To nCols
                    myRng.Cells(i, k).Value = vVALs(j, k)
                Next k
                Exit For
            End If
        Next j
    Next i
End Sub

测试输入......

提供此输出......

Answer 2

你可以试试这个

Option Explicit

Sub AlignDupes()

Dim lRow As Long, iRow As Long
Dim mainRng As Range, sortRange As Range

With ActiveSheet
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Set mainRng = .Range("A1:A" & lRow)
    Set sortRange = .Range("B1:Q1").Resize(mainRng.Rows.Count)
    .Sort.SortFields.Clear
End With
Application.AddCustomList ListArray:=mainRng

With sortRange
    .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo, OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

    iRow = 1
    lRow = .Cells(.Rows.Count, 1).End(xlUp).Row
    Do While iRow <= lRow
        Do While .Cells(iRow, 1) <> .Cells(iRow, 1).Offset(, -1)
            .Rows(iRow).Insert
            iRow = iRow + 1
            lRow = lRow + 1
        Loop
        iRow = iRow + 1
    Loop
End With

Application.DeleteCustomList Application.CustomListCount

End Sub

在excel中对齐重复列，同时保留后续列中存在的值

2 个答案: