Recherche une combinaison

robertduval · 7 Octobre 2012

Bonsoir

Encore besoin d'aide, je cherche toujours avant de demander de l'aide et la j'ai réussi en passant par la cave j'arrive au grenier vous verrez ma macro fonctionne et me donne le résultat que je souhaite mais c'est vraiment pas jolie, j'ai donc besoin de vous pour me permettre d'aller au but en m'aidant a simplifier cette macro ou faire autrement pour arriver au meme resultat car cette macro dure trop longtemps, j'ai mis des couleurs pour que vous compreniez ce que je souhaite en principe il n y a aucune couleur, merci a tous ceux qui pourront m'aider.

fhoest · 8 Octobre 2012

Re : Recherche une combinaison

Bonjour,
voici comment modifier:

Code:

 Dim t
Dim cell As Variant

Dim plage As Range
Sub Cherche_Combinaison()
'je ne sais pas si a1 est utilisé
a1 = Range("a1").Value

For Each cell In plage 'pour tout les cellules de la plage
If cell.Value = Range("b1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a33") 'si l une des cellules a la valeur de la variable b1 alors
If cell.Value = Range("c1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a34")
If cell.Value = Range("d1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a35")
If cell.Value = Range("e1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a36")
If cell.Value = Range("f1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a37")
If cell.Value = Range("g1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a38")
If cell.Value = Range("h1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a39")
If cell.Value = Range("i1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a40")
If cell.Value = Range("j1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a41")
If cell.Value = Range("k1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a42")
If cell.Value = Range("l1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a43")
If cell.Value = Range("m1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a44")
If cell.Value = Range("n1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a45")
If cell.Value = Range("o1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a46")
If cell.Value = Range("p1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a47")
If cell.Value = Range("q1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a48")
If cell.Value = Range("r1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a49")
If cell.Value = Range("s1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a50")
If cell.Value = Range("t1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a51")
If cell.Value = Range("u1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a52")
If cell.Value = Range("v1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a53")
If cell.Value = Range("w1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a54")
If cell.Value = Range("x1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a55")
If cell.Value = Range("y1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a56")
If cell.Value = Range("z1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a57")
If cell.Value = Range("aa1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a58")
If cell.Value = Range("ab1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a59")
If cell.Value = Range("ac1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a60")
If cell.Value = Range("ad1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a61")
If cell.Value = Range("ae1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a62")
Next cell 'cellule suivante

End Sub


Sub LaTotale() 'ok
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set plage = ThisWorkbook.Worksheets("Feuil3").Range("a2:a31")

t = Timer


For i = 0 To 18 ' ou 19 voir test
Call Cherche_Combinaison
Range("a1").Copy Range("ca1").Offset(0, i) 'copy cellule a1 en ca1


Range("A33:a62").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1:ae31").ClearContents
Range("A33:ae62").Copy Range("a1")
Range("A33:ae62").ClearContents

Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
'Call Cherche_Combinaison
MsgBox Timer - t
End Sub

A bientôt.

fhoest · 8 Octobre 2012

Re : Recherche une combinaison

Bonjour,

doublon de message a tester code du dessus !!

j'ai réussit a seulement gagner 4 a 5 secondes (pour commencer)
A bientôt.

robertduval · 8 Octobre 2012

Re : Recherche une combinaison

Bonsoir,

Merci fhoest beau travail, ma macro clignotait de partout la c'est stable nikel, en plus nombre de ligne reduit très bien, d'aprés toi il n y a que cette approche pour arriver a ce résultat, pas moyen de passer plus direct ?

fhoest · 8 Octobre 2012

Re : Recherche une combinaison

Bonsoir,
il y a peut être un autre moyen mais la façon de faire n'est pas si mauvaise que cela, le problème du temps c'est qu'il faut reboucler a chaque fois après un effacement des données.
je n'ai pas tout a fait saisie le fonctionnement et les choses à contrôler c'est pourquoi je ne me suis pas aventurer à changer le code.
heureux de t'avoir quand même réjouie
A+

eriiic · 8 Octobre 2012

Re : Recherche une combinaison

Bonsoir à tous,

perso je sèche déjà sur la 2nde ligne d'explication :
je cherche dans les nombres rouges le premier nombre egal au nombre bleu soit 3
nombres rouges, donc comprendre en ligne 1 je suppose.
Mais quel nombre bleu ??? Pourquoi 3, je ne vois que des 5 bleus
Et tu dis qu'en réalité il n'y a pas de couleur... Comment le retrouver alors, quelles sont ses caractéristiques ?

Et pareil pour la suite...
dans la ligne du nombre trouver je cherche le nombre egale a la zone verte soit 5
5 qui écrit sur fond bleu... Et sur fond vert on ne voit que des 6 (???)

Essayer de mettre des couleurs pour expliquer c'est bien (quoique j'ai l'impression d'être daltonien), mais ça ne remplace pas d'expliquer pourquoi c'est ce nombre qui est choisi.

eric

robertduval · 9 Octobre 2012

Re : Recherche une combinaison

Bonjour eriiiic,

C'est mal expliqué, j'ai mis des couleurs pour comprendre mieux, bien sur que tu peus enlever les couleurs et au lieu des nombres rouges prendre la ligne 1 ou la zone(a1:ae), ou pour les nombres bleus la colonne 1 ou la zone(a1:a30), j'espere que tu comprendras mieux, merci de ton aide. Merci fhoest je cherche une autre maniere de faire pour aller plus direct mais c'est dur.

A+ a vous deux

eriiic · 9 Octobre 2012

Re : Recherche une combinaison

Bonjour,

dans la ligne du nombre trouver je cherche le nombre egale a la zone verte mais aussi present dans la ligne du nombre trouver precedement
Donc tu recherches le 1er nombre commun entre la nouvelle ligne et la précédente utilisée.
En ligne 6 pourquoi 69 et non pas 21 présent en lignes 5 et 6 ?
J'en déduis qu'il faut qu'il soit présent dans toutes les lignes précédemment utilisées. Tu confirmes ?

eric

fhoest · 9 Octobre 2012

Re : Recherche une combinaison

Bonjour,
A tester environ 8 secondes:
même code avec gestion de sortie vers next cell dès qu'une valeur est trouvée

Code:

 Dim t
Dim cell As Variant

Dim plage As Range
Sub Cherche_Combinaison()
'je ne sais pas si a1 est utilisé
a1 = Range("a1").Value

For Each cell In plage 'pour tout les cellules de la plage
If cell.Value = Range("b1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a33"):  GoTo fin 'si l une des cellules a la valeur de la variable b1 alors
If cell.Value = Range("c1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a34"):  GoTo fin
If cell.Value = Range("d1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a35"):  GoTo fin
If cell.Value = Range("e1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a36"):  GoTo fin
If cell.Value = Range("f1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a37"):  GoTo fin
If cell.Value = Range("g1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a38"):  GoTo fin
If cell.Value = Range("h1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a39"):  GoTo fin
If cell.Value = Range("i1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a40"):  GoTo fin
If cell.Value = Range("j1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a41"):  GoTo fin
If cell.Value = Range("k1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a42"):  GoTo fin
If cell.Value = Range("l1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a43"):  GoTo fin
If cell.Value = Range("m1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a44"):  GoTo fin
If cell.Value = Range("n1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a45"):  GoTo fin
If cell.Value = Range("o1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a46"):  GoTo fin
If cell.Value = Range("p1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a47"):  GoTo fin
If cell.Value = Range("q1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a48"):  GoTo fin
If cell.Value = Range("r1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a49"):  GoTo fin
If cell.Value = Range("s1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a50"):  GoTo fin
If cell.Value = Range("t1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a51"):  GoTo fin
If cell.Value = Range("u1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a52"):  GoTo fin
If cell.Value = Range("v1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a53"):  GoTo fin
If cell.Value = Range("w1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a54"):  GoTo fin
If cell.Value = Range("x1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a55"):  GoTo fin
If cell.Value = Range("y1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a56"):  GoTo fin
If cell.Value = Range("z1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a57"):  GoTo fin
If cell.Value = Range("aa1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a58"):  GoTo fin
If cell.Value = Range("ab1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a59"):  GoTo fin
If cell.Value = Range("ac1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a60"):  GoTo fin
If cell.Value = Range("ad1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a61"):  GoTo fin
If cell.Value = Range("ae1").Value Then Range(cell, cell.Offset(0, 70)).Copy Range("a62")
fin:
Next cell 'cellule suivante

End Sub


Sub LaTotale() 'ok
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set plage = ThisWorkbook.Worksheets("Feuil3").Range("a2:a31")

t = Timer


For i = 0 To 18 ' ou 19 voir test
Call Cherche_Combinaison
Range("a1").Copy Range("ca1").Offset(0, i) 'copy cellule a1 en ca1


Range("A33:a62").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1:ae31").ClearContents
Range("A33:ae62").Copy Range("a1")
Range("A33:ae62").ClearContents

Next
msgbox timer-t
end sub

A+

robertduval · 9 Octobre 2012

Re : Recherche une combinaison

Bonjour a vous 2 oui a eriiiic pour ta question merci fhoest je teste ce soir

robertduval · 9 Octobre 2012

Re : Recherche une combinaison

Bonsoir

fhoest truc de fou, merci pour tout, ça fonctionne et en plus en un éclair, merci tu me fais gagner un temps fou.

robertduval · 9 Octobre 2012

Re : Recherche une combinaison

Re, fhoest

J'ai addapté ta macro a mon fichier original ou j'ai toutes mes macros avec toutes les données réelles, je voulais juste te donner les temps des 2 macros la tienne, et la mienne pour que tu vois ce que tu as réussi a faire :
Ma macro = 128 secondes
Ta macro = 3 secondes
Je n'ai meme plus besoin de chercher une autre façon de faire, ta macro est EXCEPTIONNELLE.
Encore merci le forum et surtout un GRAND MERCI a fhoest

eriiic · 9 Octobre 2012

Re : Recherche une combinaison

Bonjour,

de retour après la bataille...
Je pense qu'on peut remplacer la boucle for each cell in plage par :

Code:

For Each cell In plage    'pour tout les cellules de la plage
    For i = 1 To 30
        If cell.Value = Cells(1, i + 1).Value Then    'si l une des cellules a la valeur de la variable b1 alors
            Range(cell, cell.Offset(0, 70)).Copy Cells(i + 32, 1)
            Exit For
        End If
    Next i
Next cell    'cellule suivante

(ou qcq chose d'équivalent, non testé)

Ce ne devrait pas faire gagner de temps mais améliorer la lecture du code.

eric

robertduval · 10 Octobre 2012

Re : Recherche une combinaison

Bonjour,

Merci eriiiic de ton aide mais je pense garder la solution de fhoest, encore merci a vous deux.

A+

Effectuez une recherche sur Excel Downloads...

Recherche une combinaison

robertduval

XLDnaute Junior

Pièces jointes

fhoest

XLDnaute Accro

fhoest

XLDnaute Accro

robertduval

XLDnaute Junior

fhoest

XLDnaute Accro

eriiic

XLDnaute Barbatruc

robertduval

XLDnaute Junior

eriiic

XLDnaute Barbatruc

fhoest

XLDnaute Accro

robertduval

XLDnaute Junior

robertduval

XLDnaute Junior

robertduval

XLDnaute Junior

eriiic

XLDnaute Barbatruc

robertduval

XLDnaute Junior

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums