Supprimer des lignes entre 2 fichiers via une boucle

Sun

XLDnaute Nouveau
Bonjour,

Je cherche à supprimer/ou effacer (la ligne existe toujours mais il n'y a plus rien dessus)
certaines lignes dans un fichier, or je ne dois supprimer que certaines lignes
Je dispose de deux liste, la liste avec toutes les lignes et la liste des lignes à supprimer
(les deux listes sont sur des fichiers distincts, mais pour des raisons pratiques j'essaye d'abord de faire fonctionner la macro avec un seul fichier regroupant l'ensemble des informations)

Je fais mon code qui me semble propre (je suis débutant)
et excel m'affiche le message d'erreur suivant : Boucle sans Do

Je vous joins une copie de mon code

Dim ligne1 As Integer
Dim colone1 As Integer
Dim ligne2 As Integer
Dim colone2 As Integer

ligne1 = 1
colone1 = 1
ligne2 = 1
colone2 = 1


Do While Cells(ligne2, colone2).Value > Cells(ligne1, colone1)


If Cells(ligne1, colone1).Value <> Cells(ligne2, colone2).Value Then

ligne2 = ligne2 + 1
'compare les valeurs des cellules, si elles ne sont pas identiques
'incrémentation de la ligne2 colone2


Else
If Cells(ligne1, colone1).Value = Cells(ligne2, colone2).Value Then

Cells(ligne1, colone1).Value = ""
'si la valeur de la ligne1 colone1 = la valeur de la ligne2 colone2
'mise à 0 de la ligne1 colone1


End If


If Cells(ligne1, colone1).Value = "" Then

ligne1 = ligne1 + 1
'si la ligne1 colone1 vaut 0
'incrémentation de la ligne1 colone1 pour passer à la cellule suivante

End If


'If Cells(ligne1, colone1).Value > Cells(ligne2, colone2).Value Then

'Exit Do
'si la valeur de la cellule ligne1 colone1 est supérieure à la dernière cellule de ligne2 colone2
'on sort de la boucle
'End If


Loop

MsgBox "La suppression des fichiers est terminée"


End Sub

Si l'un d'entre vous peut m'aider à résoudre ce petit soucis de boucle, il est le bienvenue. :)

Cordialement Sun
 
Dernière édition:

mercant76

XLDnaute Impliqué
Re : problème de boucle sans do

bonjour et bienvenue,

dans ton premier "IF", mets plutôt elseif au lieu de else if.

dans une boucle loop, si un if then est mal positionné, excel dit souvent que la boucle do loop n'est pas bonne.

@+
 

néné06

XLDnaute Accro
Re : problème de boucle sans do

Bonjour Sun,Mercant76


Do While Cells(ligne2, colone2).Value > Cells(ligne1, colone1)
If Cells(ligne1, colone1).Value <> Cells(ligne2, colone2).Value Then
ligne2 = ligne2 + 1
Else
If Cells(ligne1, colone1).Value = Cells(ligne2, colone2).Value Then
Cells(ligne1, colone1).Value = ""
End If
If Cells(ligne1, colone1).Value = "" Then
ligne1 = ligne1 + 1
End If
'If Cells(ligne1, colone1).Value > Cells(ligne2, colone2).Value Then
'Exit Do
'End If

ENDIF' il manque ceci!!

Loop


A+
 

Sun

XLDnaute Nouveau
Re : problème de boucle sans do

Merci beaucoup pour ton aide Mercant.

J'ai effectuer la petite modification mais le programme ne veut toujours pas tourner.

J'ai essayer de le tourner différemment en utilisant une autre boucle et maintenant il suffit que j'amorce la comparaison, or je n'y arrive pas
(je ne vois pas quelle instruction taper)

Do Until cel.Offset <> ""



'Cells(ligne1, colone1).Value <> Cells(ligne2, colone2).Value


If Cells(ligne1, colone1).Value = Cells(ligne2, colone2).Value Then

Cells(ligne1, colone1).EntireRow.Delete

c'est la ligne en commentaire qui me pose problème, car d'elle dépend tout le reste.


Cordialement Sun

@néné : Merci de ton aide, excel m'indique une erreur de compilation dans l'initialisation de mes variables ligne1 etc ...
 
Dernière édition:

néné06

XLDnaute Accro
Re : problème de boucle sans do

Comme le disait Mercant 76

"dans une boucle loop, si un if then est mal positionné, excel dit souvent que la boucle do loop n'est pas bonne.".

Or dans ta routine il manque le "EndIf" décrit dans mon méssage.

Regardes et dit nous!!!

A+
 

Efgé

XLDnaute Barbatruc
Re : problème de boucle sans do

Bonjour à tous,
Le code de départ me laisse dubitatif.
soit j'ai raté quelque chose, soit il ne fait rien.
Le voici raccourci;
VB:
Sub Test1()
Dim ligne1 As Integer, ligne2 As Integer, colone1 As Integer, colone2 As Integer
ligne1 = 1: colone1 = 1: ligne2 = 1: colone2 = 1
Do While Cells(ligne2, colone2).Value > Cells(ligne1, colone1).Value
    If Cells(ligne1, colone1).Value <> Cells(ligne2, colone2).Value Then
        ligne2 = ligne2 + 1
    Else
        If Cells(ligne1, colone1).Value = Cells(ligne2, colone2).Value Then ligne1 = ligne1 + 1
    End If
    'If Cells(ligne1, colone1).Value > Cells(ligne2, colone2).Value Then Exit Do
Loop
MsgBox "La suppression des fichiers est terminée"
End Sub
Si quelqu'un peut m'expliquer la finalité....
Cordialement
 

Sun

XLDnaute Nouveau
Re : problème de boucle sans do

Do While Cells(ligne2, colone2).Value > Cells(ligne1, colone1).Value

Au départ je voulais partir comme ça, sauf que la liste de fichier est longue et pas forcément dans l'ordre croissant. De plus lors d'une égalité entre Cells(ligne2, colone2).Value et Cells(ligne1, colone1).Value la boucle s’arrête car la condition de boucle est finie, or il faut qu'elle continue.
 

Sun

XLDnaute Nouveau
Re : problème de boucle sans do

je débute en vba, je ne sais pas comment sélectionner 2 fichiers pour leur faire exécuter la macro

@efgé : si tu peux me communiquer le code qui permet de classer dans l'ordre croissant je suis preneur

Pour l'instant mon code ressemble à

Sub supp_fich()

Dim ligne1 As Integer
Dim colone1 As Integer
Dim ligne2 As Integer
Dim colone2 As Integer

ligne1 = 1
colone1 = 1
ligne2 = 1
colone2 = 2


Do Until cel.Offset <> ""



'Cells(ligne1, colone1).Value <> Cells(ligne2, colone2).Value


If Cells(ligne1, colone1).Value = Cells(ligne2, colone2).Value Then

Cells(ligne1, colone1).EntireRow.Delete
'si la valeur de la ligne1 colone1 = la valeur de la ligne2 colone2
'supprime la ligne


Else

ligne1 = ligne1 + 1
'si la ligne1 a été supprimer on saute à la suivante
ligne2 = ligne2 + 1
'on change de cellule de comparaison

If Cells(ligne1, colone1).Value = Cells(ligne2, colone2) Then
ligne1 = ligne1 + 1

End If




Loop

MsgBox "La suppression des fichiers est terminée"





End Sub
 

Pièces jointes

  • test.xlsm
    14.6 KB · Affichages: 34
  • test.xlsm
    14.6 KB · Affichages: 36
  • test.xlsm
    14.6 KB · Affichages: 37
Dernière édition:

Statistiques des forums

Discussions
312 369
Messages
2 087 673
Membres
103 633
dernier inscrit
Surfer