pb code vba copier lignes selon plusieurs critères

[Tismo]

Bonjour à tous, je fais encore appel à vos connaissances pour me sortir d'un pb sur lequel je penche depuis pas mal d'heures!
je cherche, dans ma base de donnés à trouver puis copier les lignes correspondant à ma recherche (sachant que cette mm recherche dépend de deux variables (double boucle for))

voici mon code:

Sub select_if()
Dim Rw As range
Dim Ligne As Long
'Sheets("BDD Call").Select
'ActiveCell.SpecialCells(xlLastCell).Select
'range(Selection, Cells(1)).Selec

For Each Rw In Selection.Rows

Ligne = Rw.Row

For j = 1 To 362
For i = 0 To 3700

If Rw.Cells(i + 2, 12).Value = j And _ '''''''''''numéro de la période, on va tester en premier toutes les cellules (i+1 , 12) avec j=1, puis 2 jusqu'à 362'''''''
Rw.Cells(i + 2, 13).Value >= (16 / 24) And _ '''''il faut ensuite que l'heure de cotation soit > à 16h00 d'où le 16/24'''''''''''
Rw.Cells(i + 2, 8).Value = 28 And _ ''''''''on ne veut que des maturités égales à 28'''''''''
Rw.Cells(i + 2, 14).Value <= 0.04 Then ''''''''''le plus à la monnaie possible''''''''''''
Rw.Copy Destination:=Worksheets("Feuil1").Cells(Ligne, 1).EntireRow
''''''''après cette ligne, je voudrai qu'il me copie la ligne i+2 sur la "Feuil1" si cette dernière répond aux critère précédents'''''''''''''
End If

Next i
Next j

Next Rw

''''''''je voudrai à la fin me retrouver avec uniquement les lignes correspondant au résultat de la recherche, les unes à la suite des autres en Feuil1''''''''''''

End Sub


merci d'avance!
Alexandre


ps je ne sais pas comment on fait pour mettre le code en format code dans le message, dsl!!

 

[Gorfael]

Re : pb code vba copier lignes selon plusieurs critères

Salut Tismo et le forum
N'utilises pas des couleurs si claires, elle sont fatigantes sur fond blanc.
En mode avancé, l'icone # met les balises de code.

Ton code ne signifiant strictement rien pour moi, des questions :
Pourquoi utiliser une plage de 0 à 3700, pour définir i, alors que tu ne l'utilises qu'en i+2 ?

Je crois comprendre que tu veux copier les lignes de la feuille "BDD Call" qui répondent aux critères (L = 1 à 362, M >= 16:00, N <= 0,04 et H = 28) sur la feuille "Feuil1".
Est-ce correct ? On doit les inscrire à la suite, derrière la dernière non-vide en M (ou H) ?

N'étant ni télépathe, ni devin et n'utilisant pas ton fichier, je n'ai que ta description pour comprendre ton problème. Alors 3700 (3702, plus exactement) et 362 sont des valeurs précises ou arbitraire ?

En utilisant un filtre auto en fixant les valeurs de M, N, H et limitant J de 1 à 362, ça permettrait de copier toutes les lignes en une seule fois, sans utiliser de boucle (quitte à les remettre en ordre après la copie), ça me semble plus rapide.
A+

 

[Tismo]

Re : pb code vba copier lignes selon plusieurs critères

Bonjour à tous, je fais encore appel à vos connaissances pour me sortir d'un pb sur lequel je penche depuis pas mal d'heures!
je cherche, dans ma base de donnés à trouver puis copier les lignes correspondant à ma recherche (sachant que cette mm recherche dépend de deux variables (double boucle for))

voici mon code:

Sub select_if()
Dim Rw As range
Dim Ligne As Long
[COLOR="green"][COLOR="blue"]'Sheets("BDD Call").Select
'ActiveCell.SpecialCells(xlLastCell).Select
'range(Selection, Cells(1)).Selec[/COLOR][/COLOR]

For Each Rw In Selection.Rows

Ligne = Rw.Row

For j = 1 To 362
For i = 0 To 3700

If Rw.Cells(i + 2, 12).Value = j And _ [COLOR="blue"]'''''''''''numéro de la période, on va tester en premier toutes les cellules (i+1 , 12) avec j=1, puis 2 jusqu'à 362'''''''[/COLOR]
Rw.Cells(i + 2, 13).Value >= (16 / 24) And _ [COLOR="blue"]'''''il faut ensuite que l'heure de cotation soit > à 16h00 d'où le 16/24'''''''''''[/COLOR]
Rw.Cells(i + 2, 8).Value = 28 And _ [COLOR="blue"]''''''''on ne veut que des maturités égales à 28'''''''''[/COLOR]
Rw.Cells(i + 2, 14).Value <= 0.04 Then [COLOR="blue"]''''''''''le plus à la monnaie possible''''''''''''[/COLOR]
Rw.Copy Destination:=Worksheets("Feuil1").Cells(Ligne, 1).EntireRow
[COLOR="blue"]''''''''après cette ligne, je voudrai qu'il me copie la ligne i+2 sur la "Feuil1" si cette dernière répond aux critère précédents''''''''''''' [/COLOR]
End If 

Next i
Next j

Next Rw

[COLOR="blue"]''''''''je voudrai à la fin me retrouver avec uniquement les lignes correspondant au résultat de la recherche, les unes à la suite des autres en Feuil1''''''''''''[/COLOR]

End Sub

merci d'avance!
Alexandre

Merci pour ta réponse, je vais te renvoyer un message avec ma base donnés pour que tu comprennes mieux mon pb.
J'ai mis 3700 car dans ma base de donnés il y a 70000 lignes et quand je lance des macros sur 70000 lignes mon petit lenovo rame un peu!!

 

[Tismo]

Re : pb code vba copier lignes selon plusieurs critères

Je me rend compte que mon code est illisible, je le post dans le fichier excel!

 

[Tismo]

Re : pb code vba copier lignes selon plusieurs critères

Ok, mon fichier est trop volumineux, je vous laisse mon mail perso: a.lucas78210@gmail.com
n'hésitez pas à me contacter, je prend toutes nouvelles idées, cela fait 24h quasiment non stop que moi et mon groupe bloquons la dessus..
Merci bcp!
Alexandre

 

[Gorfael]

Re : pb code vba copier lignes selon plusieurs critères

Salut Tismo et le forum
Je crois que tu ne comprends pas la notion de fichier d'essais. Un fichier d'essais ne comporte que quelques lignes(4 critères × 3 données (avant, pendant, après) => 12 lignes), permettant de reproduire le problème à petite échelle, et d'avoir dans ces lignes, un extrait de toutes les données pouvant créer des dysfonctionnement. C'est pas un fichier de travail (pas envie de prendre ta place ) !

Ça devrait donner une macro de type :

Sub select_if()
Dim X As Long
With Sheets("BDD Call")
    If .FilterMode Then .ShowAllData
    With .Rows(1).CurrentRegion
        .AutoFilter Field:=13, Criteria1:=">=temps(16;;)", Operator:=xlAnd
        .AutoFilter Field:=14, Criteria1:="<=0,04", Operator:=xlAnd
        .AutoFilter Field:=8, Criteria1:=28, Operator:=xlAnd
        For X = 1 To 362
            .AutoFilter Field:=12, Criteria1:=X, Operator:=xlAnd
            .Copy Sheets("Feuil1").Cells(Cells(Rows.Count, "H").End(xlUp)(2).Row, "A")
        Next X
    End With
End With
End Sub

Arrête avec les couleurs : le but est de rendre le texte plus lisible, pas plus incompréhensible !
A+