RECHERCHER et Renvoyer résultat

Le 09/08/2016 à 17:20

Bonjour/Bonsoir à vous

Je viens solliciter votre aide pour une astuce VBA qui me permet d’automatiser une tache de RECHERCHE sur un journal de suivi à 12 feuilles mensuelles.

Tous les détails et explications pour la fonction souhaitée sont bien fournis sur le fichier Excel ci-joint.

J’espère avoir pu fournir toutes les explications nécessaires.

Je reste à votre disposition bien-sur pour vous fournir tout détail complémentaire jugé nécessaire

Je vous remercie, par avance, de votre aide et je vous serai bien reconnaissante.

24journal-suivi.xlsx (63.47 Ko)
Le 09/08/2016 à 18:27

Bonjour,

On peut le faire par formules (mais en vacances, ça me fatiguerait ! )

Donc solution macro : évènementielle à coller dans le module de la feuille RECAP.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idx, ms, mch$, cpt$, m%, n%, i%, ok As Boolean
    If Not Intersect(Target, Me.Range("B8:C8")) Is Nothing Then
        Me.Range("C11:C41").ClearContents
        mch = Me.Range("B8"): cpt = Me.Range("C8")
        If mch = "" Or cpt = "" Then Exit Sub
        If Me.Range("C5") = 0 Then Exit Sub
        ms = Split("JANV FEV MARS AVR MAI JUIN JUIL AOUT SEPT OCT NOV DEC")
        m = Month(Me.Range("C5"))
        With Worksheets(ms(m - 1))
            n = .Cells(.Rows.Count, 2).End(xlUp).Row
            If n < 7 Then Exit Sub
            For i = 7 To n
                If .Cells(i, 2) = mch And .Cells(i, 4) = cpt Then
                    idx = .Cells(i, 5).Resize(, 31).Value
                    ok = True: Exit For
                End If
            Next i
        End With
        If ok Then Me.Range("C11:C41").Value = WorksheetFunction.Transpose(idx)
    End If
End Sub

J'ai considéré que tu procédais par mois entier, et donc que la date en C5 déterminait le mois choisi...

(Evidemment, si tu veux extraire sur des dates ne couvrant pas un mois entier et à cheval sur plusieurs mois, cela reste faisable mais il faut réécrire le tout.)

Cordialement.

13noura-journal-suivi.xlsm (73.81 Ko)
Le 09/08/2016 à 18:38

Bonjour Noura, MFerrand

Perso, J'ai procédé ligne par ligne pour d'éventuelles dates glissée

A+

19noura-journal-suivi.xlsm (77.39 Ko)
Le 09/08/2016 à 19:01

Bonjour à vous

Oui, c'est bien ça. C'est vraiment génial

Je vous remercie vivement. Je vous suis bien reconnaissante.

Juste une question

Je prévois avoir 8 tableaux sur la feuille RECAP repartis en 4 tableaux en haut de page l'un à coté de l'autre et 4 tableaux superposés.

Chaque tableau est destiné pour chaque machine.

Ya-t-il dans ce cas une certaine modification nécessaire pour la macro afin qu'elle fonctionnelle sur tous les 8 tableaux à créer.

Le 09/08/2016 à 19:12

Pour ce qui me concerne, si les positions relatives des cellules modifiables ne changent pas, il faudra juste étendre les tests de détection aux cellules concernées de chaque tableau, et déduire à partir de là la position du résultat.

Le 09/08/2016 à 19:27

D'accord, je vais essayer par mes très simples connaissances en Excel, et si blocage, je reviendrai vers vous.

Merci sincèrement une autre fois pour vous.

Le 09/08/2016 à 23:08

Bonjour/Bonsoir

Tout d'abord, j'adresse mes vifs remerciement à MFerrand et BrunoM45 de leur aimable aide et de leur prompte réponse à mon sujet.

Je pensais pouvoir adapter la macro VBA sur les 8 Tableaux créés sur la page RECAP comme illustré sur mon fichier, néanmoins je le trouve dur et je me trouve incapable de le faire.

Alors je reviens vers vous pour ce blocage.

Désolée, j'ai oublié de joindre le fichier avec mon msg

Ci-joint Fichier modifié et complété

11journal-suivi-2.xlsm (73.57 Ko)
Le 09/08/2016 à 23:46

C'est pour doubler toutes les références que tu les disposes sur 2 rangs ?!

Pour l'instant je regarde un film !

Le 10/08/2016 à 01:03

Version aménagée qui couvre les 8 tableaux... mais en ligne [Je ne vois pas de raison de me compliquer alors que dans tous les cas il faut scroller pour les voir...]

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim idx, ms, cible As Range, mch$, cpt$, m%, n%, i%, ok As Boolean
    If Target.Count > 1 Then Exit Sub
    For i = 0 To 7
        If Not Intersect(Target, Me.Range("B8:C8").Offset(, i * 4)) Is Nothing Then
            n = Target.Column: n = (n + 1) Mod 2
            Set cible = Target.Offset(, n)
            Exit For
        End If
    Next i
    If cible Is Nothing Then Exit Sub
    If cible.Offset(-3) = 0 Then Exit Sub
    mch = cible.Offset(, -1): cpt = cible
    If mch = "" Or cpt = "" Then Exit Sub
    m = Month(cible.Offset(-3))
    Set cible = cible.Offset(3).Resize(31)
    cible.ClearContents
    ms = Split("JANV FEV MARS AVR MAI JUIN JUIL AOUT SEPT OCT NOV DEC")
    With Worksheets(ms(m - 1))
        n = .Cells(.Rows.Count, 2).End(xlUp).Row
        If n < 7 Then Exit Sub
        For i = 7 To n
            If .Cells(i, 2) = mch And .Cells(i, 4) = cpt Then
                idx = .Cells(i, 5).Resize(, 31).Value
                ok = True: Exit For
            End If
        Next i
    End With
    If ok Then cible.Value = WorksheetFunction.Transpose(idx)
End Sub

Cordialement.

14noura-journal-suivi-2.xlsm (84.13 Ko)
Le 10/08/2016 à 01:35

bonjour

La boucle complique le code et augmente la durée d’exécution voici une autre solution :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim derl As Integer, x As Integer, col As Integer, mchn As String, cptr As String
Dim dte1 As Date, dte2 As Date
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, Me.Range("B8:C8,F8:G8,J8:K8,N8:O8,B51:C51,F51:G51,J51:K51,N51:O51")) Is Nothing Then
col = WorksheetFunction.Even(Target.Column)
mchn = Me.Cells(Target.Row, Target.Column - (col - Target.Column))
cptr = Me.Cells(Target.Row, Target.Column - (col - Target.Column) + 1)
dte1 = Me.Cells(Target.Row - 3, Target.Column - (col - Target.Column) + 1)
dte2 = Me.Cells(Target.Row - 3, Target.Column - (col - Target.Column) + 2)
Me.Range(Cells(Target.Row + 3, Target.Column - (col - Target.Column) + 1), _
Cells(Target.Row + 32, Target.Column - (col - Target.Column) + 1)).ClearContents
If mchn = "" Or cptr = "" Then Exit Sub
If Not IsDate(dte1) Then MsgBox "bla bla bla": Exit Sub 'soit = 0 ou = ""
If Not IsDate(dte2) Then MsgBox "bla bla bla": Exit Sub 'soit = 0 ou = ""
            With Worksheets(Month(dte1))
            derl = .Cells(.Rows.Count, 2).End(xlUp).Row
            For x = 7 To derl ' ttes une valeur inf a 7 est deja passée
            If .Cells(x, 2) = mchn And .Cells(x, 4) = cptr Then
            Me.Range(Cells(Target.Row + 3, Target.Column - (col - Target.Column) + 1), _
            Cells(Target.Row + 32, Target.Column - (col - Target.Column) + 1)).Value = WorksheetFunction.Transpose(.Range("E" & x & ":AI" & x).Value)
            End If
            Next x
            End With
End If
End Sub
15journal-suivi-2.xlsm (85.72 Ko)
Le 10/08/2016 à 02:33

Bonsoir Amir,

Je dois te contredire ! Une mesure pour obtenir le même résultat sur ton fichier et sur celui que j'ai fourni donne comme temps d'exécution : 31,25 millisecondes pour ton fichier et 15,625 millisecondes sur le mien.

Cordialement.

Je rectifie, après tous les tests possibles à plusieurs reprises sur les 2 fichiers : les temps alternent entre 15,625 et 31,25 (je n'ai sorti qu'une fois un temps différent : 15,625 s'obtient sur la première ligne, mais pas toujours, ceci sur les 2 fichiers.

On doit donc considérer qu'il n'y a aucune différence significative et égalité de la durée d'exécution.

La boucle n'est donc pas en cause !

Le 10/08/2016 à 11:24

Bonjour MFerrand

Seulement j ai pensé qu’on doit éviter les boucle tant que possible, pcq ton code exécute la boucle tjrs même si il n y pas un cible ==> temps supplémentaire,c est évident que la durée augmente au fur et mesure que le nombre de tableau augmente (Si on suppose par exemple que la boucle passe par une milliseconde alors pour arriver au 8 eme nous aurons 8 millisecondes).

En plus tant que nous ne savons pas ce qu’il tourne dans sa tête moi j ai pensé qu’on doit respecter la présentation de ces tableaux

Que penses-tu ?!

Cordialement

Le 10/08/2016 à 11:47

Il faudrait pouvoir tester si une différence apparaît entre une boucle de 8 tours et une reconnaissance de plage multizones de 8 zones !

Pour obtenir un résultat utile, il faudrait répéter l'opération en boucle sur quelques dizaines de milliers de tours au moins pour voir si des écarts significatifs apparaissent.

A l'occasion, on pourra s'y amuser. Mais sur une opération cela restera tout à fait infinitésimal.

Cordialement.

Le 10/08/2016 à 13:45

bonjour

Je comprends, en premier temps moi aussi j ai pensé d’utiliser une boucle, mais mon bute était d’écrire un code sans boucle et je pense que j ai arrivé.

cordialement

Le 10/08/2016 à 15:51

Bonjour

Merci AMIR, merci Mferrand, de l'attention que vous avez apportée à mon sujet.

Chapeau tiré.

Toutes vos solutions proposées ont bien abouti au bon résultat recherché.

Je vous remercie et je remercie tout ce qui a essayé de participer de près ou de loin à mon sujet.

Juste une petite information de votre part

En vue d'améliorer mes tableaux sur la feuille RECAP, je prévois insérer une ou 2 colonnes de plus à gauche.

Dans ce cas, puis-je savoir les modifications a faire sur le module VB??

J'ai essayé provisoirement cette insertion de colonne et j'ai remarqué que la fonction de recherche a cessé de fonctionner.

Bonne après midi à vous toutes et tous.

Le 11/08/2016 à 01:13

Bonsoir,

Modifiant l'adresse des cellules testées, il faut corrélativement les modifier dans la macro...

Rechercher des sujets similaires à "rechercher renvoyer resultat"