VBA - rechercher une ligne avec 3 critères [Résolu/Fermé]

Signaler
-
 Liandar -
Bonjour à tous.

Je débute depuis 2 mois sur un programme de facturation sous excel/VBA, et je solicite votre aide car je bloque sur une fonction. cela fait des heures et des heures que je cherche, mais je ne trouve pas Je m'explique:

J'ai un tableau de 10 colonnes et 10000 lignes. La pluspart sont encore vides. Je souhaiterais chercher les lignes correspondantes aux 3 critères de recherche mis en variables et les supprimer.

exemple:

critère1 = "Laurent" critère2 = "2011" critère3 = "payé"

_____________________________________________________________________
| A | B | C |
|_________________|___________________________|______________________|
|_________________|___________________________|______________________|
|_________________|___________________________|______________________|
|_________________|___________________________|______________________|
|_________________|___________________________|______________________|
|_________________|___________________________|______________________|

SI A = critère1 ET B = critère2 ET C = critère 3 ==> on supprime la ligne.

De plus, toutes mes lignes remplies sont regroupées en haut, donc si A devient vide, on arrete la boucle
(pour ne pas perdre de temps avec les lignes vides.)

En vous remerciant milles fois par avance!

Laurent

2 réponses

Messages postés
16300
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
17 novembre 2020
3 072
Bonjour,

essaies cette macro
Option Explicit 
Const criter1 As String = "Lucien" 
Const criter2 As Integer = 2011 
Const criter3 As String = "payé" 

Sub supprimer_svt_criteres() 
Dim nbre As Integer, Lig As Integer, Cptr As Integer 

nbre = Application.CountIf(Columns("A"), criter1) 
If nbre = 0 Then GoTo vide 

Application.ScreenUpdating = False 
Lig = 1 
For Cptr = 1 To nbre 
     Lig = Columns("A").Find(criter1, Cells(Lig, "A"), xlValues).Row 
          If Cells(Lig, "B") = criter2 And Cells(Lig, "C") = criter3 Then 
               Rows(Lig).Delete 
               Lig = Lig - 1 
          End If 
Next 
Exit Sub 
vide: 
MsgBox criter1 & " inconnu dans la colonne A!", vbCritical 
End Sub 


mais si c'est encore long, tu dis, on peut aller beaucoup + vite (macro + compliquée)

je n'ai pas géré les 3 critères car conditions, emplacement, méthode non indiquées
Michel
Bonsoir,

Avant tout ,merci beaucoup pour votre post. J'ai l'impression que mon problème se résout petit à petit, et c'est pas rien!

J'ai donc adapté votre code à mon script, et finalement, je passe les 3 critères par arguments comme ceci:

===========================================

Option Explicit

Sub supprimer_svt_criteres(criter1, criter2, criter3)
Dim nbre As Integer, Lig As Integer, Cptr As Integer

If (criter3 = "bat") Then
        criter3 = "BATHELEC"
    Else
        criter3 = "ESP"
End If

nbre = Application.CountIf(Columns("A"), criter1)
If nbre = 0 Then GoTo vide

Application.ScreenUpdating = False
Lig = 1
For Cptr = 1 To nbre
     Lig = Columns("A").Find(criter1, Cells(Lig, "A"), xlValues).Row
          If Cells(Lig, "B") = criter2 And Cells(Lig, "C") = criter3 Then
               Rows(Lig).Delete
               Lig = Lig - 1
          End If
Next
Exit Sub

MsgBox criter1 & " inconnu dans la colonne A!", vbCritical
End Sub


=============================================

Mon problème: le messageBox "-Critère1- inconnu dans la colonne A!" se lance à chaques fois. pourtant, mes critères sont bien contenus dans les 3 variables criter1, criter2 et criter3 (j'ai testé grâce à la msgbox).

Je sens qu'il ne manque pas grand chose ^^

Merci beaucoup! :))
Messages postés
16300
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
17 novembre 2020
3 072
normalement criter12,3 sont en param^tre

donc (attention pas de parenthèses dans l"'appel)
sub test() 
supprimer_svt_criteres "Lucien", 2001, "bat" 
end sub
Bonjour Michel_m.

Avant tout, merci beaucoup pour votre aide, tout marche comme je le souhaite, il me reste juste un petit détail, lorsque j'execute mon code, les lignes ciblées s'effacent correctement, mais il m'affiche en fin de procédure un message d'erreur 91 dont voici le lien de l'image:

http://farm7.static.flickr.com/6123/5953757210_4f0dab4def.jpg


quand je lance le débuggeur, voici l'écran:

http://farm7.static.flickr.com/6017/5953757228_bea73d3234.jpg


Quoi qu'il en soit, merci pour tout pour l'aide, vous êtes mon sauveur.

Passez une très bonne journée.

PS: j'ai adapté le code en fonction de mes besoins, j'ai par exemple enlevé votre bout de code pour terminer la fonction si la ligne n'existe pas car elle existera forcément quand cette fonction se lancera.

code:

Option Explicit 


Sub test() 

supprimer_svt_criteres "18", "Janvier 2011", "bat" 
End Sub 


Function supprimer_svt_criteres(criter1, criter2, criter3) 
Dim nbre As Integer, Lig As Integer, Cptr As Integer 

If (criter3 = "bat") Then 
        criter3 = "BATHELEC" 
    Else 
        criter3 = "ESP" 
End If 

Lig = 1 
Application.DisplayAlerts = False 
For Cptr = 1 To 2000 
     Lig = Columns("A").Find(criter1, Cells(Lig, "A"), xlValues).Row 
          If Cells(Lig, "B") = criter2 And Cells(Lig, "C") = criter3 Then 
               Rows(Lig).Delete 
               Lig = Lig - 1 
          End If 
Next 
End Function
Messages postés
16300
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
17 novembre 2020
3 072
Application.DisplayAlerts = False n'est jamais utilisé sans
Application.DisplayAlerts = true après sinon c'est définitif m^me la macro terminée!!!
et je ne vois pas son utilité dans le code :regarde l'aide à ce sujet

Pourquoi cette ligne qui ralentit tout et produit une erreur ? :-(((
For Cptr = 1 To 2000 
alors qu'avec ce que je t'avais donné on ne boucle que sur les valeurs criter1au lieu de 2000 fois ; avec ton invention magique, tu as une erreur une fois que la boucle a trouvé tous les criter1 :-(((

et de plus tu enlèves
Application.ScreenUpdating = False 
qui fige le défilement de l'écran et fait gagner un temps fou !!!! :-(((

Je me demande à quoi je sers et pourquoi tu demandes de l'aide !!!
Bonjour, je viens d'essayer, et effectivement , cela fonctionne.

Merci infiniment pour votre aide et excusez mon amateurisme :)

@+