Alignez la colonne en double dans Excel en conservant les valeurs présentes dans la colonne suivante

Mes données sont répandues dans de nombreuses colonnes. Dans ce cas, la colonne A et la colonne B ont un nom identique (en double), tandis que les colonnes C à Q sont des valeurs liées à la colonne B. Je souhaite aligner la colonne B vers la colonne A tout en préservant les valeurs suivantes telles qu'elles sont.

REMARQUE : Ma question est très similaire à celle-ci " Alignez des données identiques dans deux colonnes tout en préservant les valeurs au 3ème dans excel "

Mais dans mon cas, je souhaite conserver plus de colonnes subséquentes (de C à Q). J'ai joué avec un code donné en tant que solution par @Jeeped dans cette publication mais a échoué.

Puis-je get de l'aide à cet égard,

J'ai essayé le code suivant: 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

J'ai essayé de modifier la plage ("B1: C" et lr) à la plage ("B1: Q" et lr), mais cela n'a pas fonctionné. Ensuite, j'ai changé .Résize (1,2) à .Resize (1,3), et il a copié deux lignes suivantes, mais lorsque j'ai inséré un code avec .Resize (1,4), cela n'a pas fonctionné.

J'espère que cette publication modifiée aidera à répondre à ma question.

Avec le meilleur

Basé sur le code dans le lien d'origine, devrait fonctionner avec n'importe quel nombre de colonnes …

 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

Entrée test …

entrez la description de l'image ici

Fournit cette sortie …

entrez la description de l'image ici

vous pouvez essayer ceci

 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