Comparaison 2 colonnes

pereda09

XLDnaute Nouveau
Bonjour,
Cette macro ne lit pas toutes les lignes "20000" de la colonne sélectionnée.
Je voudrais également transférer tous les enregistrements coloriés vers une nouvelle feuille.
Merci pour votre aide.

Sub Compare2colonnes()

Dim Plg As Range, c As Range
Dim i As Long, Msg As String

Set Plg = Application.InputBox("Sélectionne la colonne.", Type:=8)

For Each c In Plg.Columns(1).Cells
If c < c.Offset(0, 1) Then
Union(c, c.Offset(0, 1)).Interior.ColorIndex = 6
i = i + 1
End If
Next
End Sub
 

Yaloo

XLDnaute Barbatruc
Re : Comparaison 2 colonnes

Bonjour pereda :),

Merci de mettre un fichier, ça évite aux autres de le faire et surtout de ne pas faire ce qu'il faut :eek:

A+

Martial

Edit : Salut Robert, pas mal cette macro (comme toujours ;) )
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Comparaison 2 colonnes

Bonjour Pereda, Martial, bonjour le forum,

Oui Martial a raison avec un fichier ça nous évite de recréer ton contexte...
Une proposition :

Code:
Sub Compare2colonnes()

Dim Plg As Range, c As Range
Dim lc As Range 'déclare la variable lc (Lignes Colorées)

Sheets("Feuil2").Range("A1").CurrentRegion.Clear 'efface les anciennes lignes de l'onglet "Feuil2"
Set lc = Range("A1") 'définit plage lc
deb: 'étiquette
Set Plg = Application.InputBox("Sélectionne la colonne.", Type:=8)
'si plusieurs colonnes sélectionnées, message, rouvre l'InputBox via l'étiquette "deb"
If Plg.Columns.Count > 1 Then MsgBox "Vous ne devez sélectionner qu'une seule colonne !": GoTo deb
For Each c In Plg.SpecialCells(xlCellTypeConstants) 'boucle sur toutes les cellules éditées c de la plage Plg
    If c.Value < c.Offset(0, 1).Value Then 'condition : si la cellule c est inférieure de celle de la cellule une colonne à coté
        c.Resize(1, 2).Interior.ColorIndex = 6 'colore les deux cellules de jaune
        'redéfinit la plage lc
        Set lc = IIf(lc.Cells.Count = 1, c.Resize(1, 2), Application.Union(lc, c.Resize(1, 2)))
    End If 'fin de la condition
Next 'prochaine cellule de la boucle
lc.Copy Sheets("Feuil2").Range("A1") 'copy la plage lc dans A1 de l'onglet "Feuil2"
End Sub
 

Discussions similaires

Réponses
6
Affichages
321

Membres actuellement en ligne

Statistiques des forums

Discussions
312 779
Messages
2 092 046
Membres
105 168
dernier inscrit
makari69