Comparaison d'une section de ligne à une autre

  • Initiateur de la discussion Initiateur de la discussion leop93
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

leop93

XLDnaute Occasionnel
Bonjour

J'avance sur mon projet et je me retrouve confronté à un soucis que je n'avais pas auparavant car les valeurs rentrées dans le tableau sont de plus en plus nombreuses et parfois ne diffèrent que d'une petite valeur dans une des cases.

Jusqu'à maintenant, je me sers de ce code pour supprimer les doublons:
Code:
Sub supprimeDoublons()
Dim MaCellule
MaCellule = ("C2")
Range(MaCellule).Select
ActiveCell.CurrentRegion.Sort Key1:=Range(MaCellule), Order1:=xlAscending, Header:=xlYes
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select

    While ActiveCell <> ""
        If ActiveCell = donnee1 Then
            ActiveCell.EntireRow.Delete
            ActiveCell.Offset(-1, 0).Select
            donnee1 = ActiveCell
            ActiveCell.Offset(1, 0).Select
        Else
            donnee1 = ActiveCell
            ActiveCell.Offset(1, 0).Select
        End If
    Wend
    
End Sub
J'aimerais pouvoir à la place de comparer une seule cellule (ici "C2") entre les lignes que je compare comparer la ligne de la cellule A2 à la cellule M2.

J'ai essayé de faire MaCellule = ("A2:M2") mais cela revient au même que MaCellule = ("C2") apparemment...

J'ai aussi essayé de me servir d'un Range(MaCellule)EntireRow.Select mais en vain.

Je vais préparer un fichier de test, mais je ne suis pas sûr que ça soit très utile, c'est sûrement une subtilité toute simple que je n'ai pas saisi. 😀

Bonne journée

Leop93
 
Re : Comparaison d'une section de ligne à une autre

Bonjour,

Essai ceci peut-être !
Code:
Sub supprimeDoublons()
Dim i as integer
for i = 1 to 13
cells(2,i).Select
ActiveCell.CurrentRegion.Sort Key1:=cells(2,i), Order1:=xlAscending, Header:=xlYes
donnee1 = ActiveCell
ActiveCell.Offset(1, 0).Select

    While ActiveCell <> ""
        If ActiveCell = donnee1 Then
            ActiveCell.EntireRow.Delete
            ActiveCell.Offset(-1, 0).Select
            donnee1 = ActiveCell
            ActiveCell.Offset(1, 0).Select
        Else
            donnee1 = ActiveCell
            ActiveCell.Offset(1, 0).Select
        End If
    Wend
cells(2,i+1).Select
next i
   
End Sub
 
Re : Comparaison d'une section de ligne à une autre

Bonjour Jbarbe

J'ai essayé ton code, ça ne fonctionne malheureusement pas. Et ça me retire même des occurences qui devraient bien être là.

Je vais préparer un fichier test reprenant la base de mon fichier actuel et le joindre à mon premier message.

Leop93
 
Re : Comparaison d'une section de ligne à une autre

Je m'excuse ! J'aurais dû vous dire de tester la macro sans grande conviction ! En effet elle ne peut vous satisfaire sans une grande modification !

Comme il s'agit de trouver des doublons sur une ligne, j'ai trouvé cela que je suis en train de travailler !

Top Assistante - Macros supprimer les doublons

Bonne journée
 
Re : Comparaison d'une section de ligne à une autre

Pas de soucis.

Je vais aller regarder votre lien après manger, il y a pas mal d'explication apparemment, je devrais peut être réussir à trouver une manip.

Je m'arrache les cheveux sur ce lien qui m'a l'air de fonctionner qu'une fois sur deux !!!!!!

Je comprends qu'il n'y a pas beaucoup de monde à se précipiter sur votre demande ( cela aurait été plus facile de comparer 2 lignes ou 2 colonnes )!!!!

Bon courage !
 
Re : Comparaison d'une section de ligne à une autre

Bonjour leop93, JBARBE,

Si je comprends bien vous voulez supprimer les lignes d'un tableau faisant doublons.

Dans ce cas toujours penser à l'objet "Dictionary" :

Code:
Sub Doublons()
Dim r As Range, ncol%, d As Object, t$, col%, doublon As Range
Set r = [A:M] 'base à adapter
Set r = Intersect(r, ActiveSheet.UsedRange)
If r Is Nothing Then Exit Sub
ncol = r.Columns.Count
Set d = CreateObject("Scripting.Dictionary")
For Each r In r.Rows
  t = ""
  For col = 1 To ncol
    t = t & r.Cells(col) & Chr(1) 'concaténation des cellules
  Next
  t = UCase(Application.Trim(t)) 'MAJUSCULE+SUPPRESPACE
  If d.Exists(t) Then 'si doublon
    Set doublon = Union(IIf(doublon Is Nothing, r, doublon), r)
  Else
    d(t) = t
  End If
Next
If Not doublon Is Nothing Then doublon.Delete xlUp 'lignes du tableau
'If Not doublon Is Nothing Then doublon.EntireRow.Delete 'lignes entières
End Sub
La casse et les espaces superflus n'ont pas d'importance.

Fichier joint.

A+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour