Probleme dedoublonnage a l'infini!

M

Metek

Guest
Bonjour!
Je viens vous voir car j'ai enormement de problemes avec une de mes macros!
Je dispose d'un tableau avec plus de 10 colonnes et je souhaite
supprimer les lignes identiques suivant un certain criteres!
Prenons la ligne 1 et la ligne 2
la ligne B seront un doublon si et seulement si la cellule F1 et F2 sont identiques ainsi que les cellules H1 et H2 et de que les
cellules C1 et C2!
J'ai donc réalisé cette macro:private Sub btnDoublons_Click()
Sheets('Feuil1').Select
Dim J As Integer
Dim temp As Integer
Range('G2').Select
J = 2
temp = 3
While Range('G' & J).Value <> ''
If Range('F' & J).Value = Range('F' & temp).Value Then
Do While Range('F' & J).Value = Range('F' & temp).Value
If Range('C' & J).Value = Range('C' & temp).Value And Range('H' & J).Value = Range('H' & temp).Value Then
Rows(temp).Select
Selection.Delete Shift:=xlUp
End If
Loop
End If
J = J + 1
temp = J + 1
Wend
End Sub



La macro tourne indefiniment a partir de la ligne 25 pourtant cette ligne possede la meme structure que toutes les autres!!

Merci d'avance.
 

Abel

XLDnaute Accro
Bonjour Metek,

Essaie :

for j=2 to Range ('g65536').end(lxup).row
If Range('F' & J).Value = Range('F' & j+1).Value Then
Do While Range('F' & J).Value = Range('F' & j+1).Value
If Range('C' & J).Value = Range('C' & j+1).Value And Range('H' & J).Value = Range('H' & j+1).Value Then
Rows(j+1).Select
Selection.Delete Shift:=xlUp
End If
Loop
End If
J = J + 1
next j

Je n'ai pas testé mais ça devrait le faire.

Le code va tourner de la ligne 2 à la première ligne remplie de la colonne 'G' en partant du bas.
Je me suis permis de remplacer 'temp' par 'j+1'. Il n'y a pas besoin d'une variable supplémentaire ici.

Attention, quant tu supprimes une ligne, il faut refaire le test sur la ligne en cours. Et oui, si tu supprimes la ligne 4, la ligne 5 devient la 4. Tu me suis ?
Hop ! On fait 'Next' et on passe au test de la ligne 5. Tu me suis toujours ?

Résultat, l'ex ligne 5 qui est devenue la 4 n'est pas testée. Pas glop !


En espérant que cela te dépanne.

Abel.
 

2passage

XLDnaute Impliqué
bonjour,

dans ce cas, pourquoi ne pas commencer par le bas ? ;) voici ma proposition :

Code:
Dim lig, i As Integer
lig = ActiveSheet.Range('G65536').End(xlUp).Row
For i = lig To 3 Step -1
    With ActiveSheet
    If .Range('C' & i).Value = .Range('C' & i).Offset(-1, 0).Value And .Range('H' & i).Value = .Range('H' & i).Offset(-1, 0).Value Then
        Rows(i).Delete
    End If
    End With
Next i


A+

Edit : Han j'ai cru voir un Pascal....
Message édité par: 2passage, à: 30/08/2005 15:30

Message édité par: 2passage, à: 30/08/2005 15:32
 

PascalXLD

XLDnaute Barbatruc
Modérateur
Niark Niark 2passage sur ce coup je fus plus rapide d'1 minute pour l'idée de le faire à l'envers mais tu es beaucoup plus complet

sinon tu peux eviter le select dans ton code et faire direct

Rows(i).Delete

Bonne journée

EDITION : C'est pas juste si tu supprimes ton select pendant que je tape ma phrase :p

Message édité par: Pascal76, à: 30/08/2005 15:33
 

2passage

XLDnaute Impliqué
re,

héhé... en fait, en voyant le select, je me dis 'pouah quelle horreur'.. du coup je le vire et je me dis :'tiens ! si on jouait au code le plus court...' donc vouala :

Code:
Private Sub CommandButton1_Click()
For i = ActiveSheet.Range('G65536').End(xlUp).Row To 3 Step -1
    If ActiveSheet.Range('C' & i).Value = ActiveSheet.Range('C' & i).Offset(-1, 0).Value And ActiveSheet.Range('H' & i).Value = ActiveSheet.Range('H' & i).Offset(-1, 0).Value Then Rows(i).Delete
Next i
End Sub

plus court je sais plus faire ;) :)
A+
 
M

metek

Guest
bravo je n'ai qu'une chose a dire 'Champagne'
La difference entre vous et moi --> 3 lignes de code qui marchent :)
J'ai un dernier soucis et apres promis je ne vous embete plus
j'ai une cellule contenant par exemple 'Michel Jean Paul (MR)'
et une autre 'Michel Jean Paul (MR.)' probleme c'est que le
point est considéré comme une difference :(
Serait il possible de pallier avec cette macro a ce genre de problemes???

Merci d'avance et merci encore pour la rapidité et les reponses
 

Abel

XLDnaute Accro
Re,

Aïe !

Là ça devient dur. Si la différence est toujours un 'point' on peut faire quelque chose. Mais quid de l'espace en plus, du tiret qui traine, etc.

Je ne sais pas s'il existe des solutions.

Sauf si les noms existent déjà. A ce moment on peut 'forcer' la saisie à partir d'une liste préétablie.

Regarde dans 'Données/Validation' et 'Autoriser liste'. Cela permettra de 'figer' les saisies.

Abel.

Message édité par: Abel, à: 30/08/2005 16:06
 
M

Metek

Guest
Bon j'avais résolu ce probleme en changeant moi meme les données et remplacant DR. par vide et tout le reste car les caracteres a remplacer sont aleatoires!!!
Tant pis ca remplira mes heures au moins!
Merci encore pour toutes ces reponses!!!
 

Discussions similaires

Réponses
1
Affichages
686
Réponses
16
Affichages
953

Membres actuellement en ligne

Statistiques des forums

Discussions
299 832
Messages
1 979 414
Membres
206 721
dernier inscrit
Sud catering