Comparaison entre 2 lignes et mise en évidence de la différence

Question

Vous auriez besoin d'aide pour comparer deux lignes dans Excel et mettre en évidence la différence.

Je possède ce code:

With ActiveSheet 

    Last_Column = .Cells.Find("*", [A1], , , xlByColumns, xlPrevious).Column 

    For lLoop = 1 To Last_Column 
     If .Cells(1, lLoop).VALUE <> .Cells(2, lLoop).VALUE Then 
      .Cells(1, lLoop).Interior.ColorIndex = 4    
     End If  
    Next 

End With 

Mais il ne compare que les deux premières lignes. Pourriez-vous m'aider à comparer entre les rangées (1 & 2,3 & 4,5 & 6 etc) jusqu'à la fin de la feuille et mettre en évidence les différences.

Answer 1

Essayez le code ci-dessous, l'explication dans les commentaires du code:

Option Explicit 

Sub CompareRows() 

Dim i As Long, Col As Long 
Dim LastRow As Long, Last_Column As Long 

With Worksheets("Sheet1") '<-- modify to your sheet's name (don't rely on ActiveSheet) 
    ' get last row 
    LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
    ' first add a loop of rows, step every 2 
    For i = 1 To LastRow Step 2 
     Last_Column = .Cells(i, .Columns.Count).End(xlToLeft).Column ' get last column in current row 

     ' loop through columns 
     For Col = 1 To Last_Column 
      If .Cells(i, Col).Value <> .Cells(i + 1, Col).Value Then 
       .Cells(i, Col).Interior.ColorIndex = 4 
      End If 
     Next Col    
    Next i 
End With 

End Sub 

Answer 2

Le code que vous avez ne fonctionnera que pour les lignes 1 et 2 car vous les avez codés en dur dans le code et vous parcourez également les colonnes qui ne passent pas par des lignes.

Vous avez besoin de deux boucles, une en boucle et une autre en boucle.

pour cette solution ...

Sub CompareRows() 
Dim LastRow As Long, LastColumn As Long 
Dim i As Long, j As Long 
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
LastColumn = Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 

For i = 1 To LastRow Step 2 
    For j = 1 To LastColumn 
     If Cells(i, j) <> Cells(i + 1, j) Then Cells(i, j).Interior.ColorIndex = 4 
    Next j 
Next i 
End Sub