同时在Excel中alignment重复的列，保留后续列中的值

我的数据被分散在许多列中。 在那里，列A和列B具有相同的名称（重复），而列C到Q是与列B有关的值。我想alignment列B到列A，同时保留后续值，因为它是。

注 ： 我的问题是非常相似的这一个“ 在两个列中保持相同的数据，而在Excel中保留第三个值 ”

但在我的情况下，我想保留更多的后续列（从C到Q）。 我使用了@Jeeped在这个post中给出的代码作为解决scheme，但是失败了。

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

我试过下面的代码： 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）插入一个代码，没有工作。

希望这个编辑的post有助于回答我的问题。

最好的

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 

testinginput…

提供这个输出…

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