Macro évémentielle : Création d'une liste à partir de 2 tableaux

legrand.slb

XLDnaute Nouveau
Bonjour à tous

Pierrot93 m’a beaucoup aidé la semaine dernière sur ce sujet (encore merci). Peut-être es-tu encore disponible,...... ou un autre Pro d'Excel.

Aujourd’hui, je souhaite faire une action inverse décrite dans le fichier joint

Merci à tous
Bertrand
 

Pièces jointes

  • Sportifs.xls
    41.5 KB · Affichages: 48
  • Sportifs.xls
    41.5 KB · Affichages: 49
  • Sportifs.xls
    41.5 KB · Affichages: 49

myDearFriend!

XLDnaute Barbatruc
Re : Macro évémentielle : Création d'une liste à partir de 2 tableaux

Bonsoir legrand.slb, le Forum,

Sauf erreur, une façon de faire dans ton classeur ci-joint modifié :

La procédure de traitement est lancée par l'évènement Worksheet_BeforeDoubleClick() de la feuille. J'ai utilisé le code suivant pour ce traitement :

Code:
[COLOR=GRAY][B][I]DANS UN MODULE DE CODE STANDARD[/I][/B][/COLOR]

[COLOR=NAVY]Option Explicit[/COLOR]

[COLOR=NAVY]Sub[/COLOR] Traitement(Cel [COLOR=NAVY]As[/COLOR] Range)
[COLOR=GREEN]'myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] Sportifs [COLOR=NAVY]As New[/COLOR] Collection
[COLOR=NAVY]Dim[/COLOR] TabTemp [COLOR=NAVY]As Variant
Dim[/COLOR] Sports [COLOR=NAVY]As String[/COLOR], Sport [COLOR=NAVY]As String
Dim[/COLOR] L [COLOR=NAVY]As Long
Dim[/COLOR] C [COLOR=NAVY]As Byte[/COLOR], Car [COLOR=NAVY]As Byte[/COLOR]
    [COLOR=GREEN]'Extrait les sports concernés (sans séparateur)[/COLOR]
    Sports = Replace(Cel.Offset(0, -1).Text, " - ", "")
    [COLOR=NAVY]With[/COLOR] Sheets("Sportifs")
        [COLOR=GREEN]'Mémorise le tableau des sportifs[/COLOR]
        TabTemp = .Range("B3").CurrentRegion.Value
        [COLOR=GREEN]'Pour chaque sport à trouver[/COLOR]
        [COLOR=NAVY]For[/COLOR] Car = 1 [COLOR=NAVY]To[/COLOR] Len(Sports)
            Sport = Mid(Sports, Car, 1)
                [COLOR=NAVY]For[/COLOR] C = 2 [COLOR=NAVY]To UBound[/COLOR](TabTemp, 2)
                    [COLOR=NAVY]If[/COLOR] TabTemp(1, C) = Sport [COLOR=NAVY]Then
                        For[/COLOR] L = 3 [COLOR=NAVY]To UBound[/COLOR](TabTemp, 1)
                            [COLOR=NAVY]If[/COLOR] TabTemp(L, C) <> "" [COLOR=NAVY]Then[/COLOR]
                                [COLOR=GREEN]'"Collecte" le nom des sportifs (sans doublon)[/COLOR]
                                [COLOR=NAVY]On Error Resume Next[/COLOR]
                                Sportifs.Add TabTemp(L, 1), [COLOR=NAVY]CStr[/COLOR](TabTemp(L, 1))
                                [COLOR=NAVY]On Error GoTo[/COLOR] 0
                            [COLOR=NAVY]End If
                        Next[/COLOR] L
                        [COLOR=NAVY]Exit For
                    End If
                Next[/COLOR] C
        [COLOR=NAVY]Next[/COLOR] Car
    [COLOR=NAVY]End With[/COLOR]
    [COLOR=GREEN]'MAJ résultats[/COLOR]
    [COLOR=NAVY]With[/COLOR] Sheets("Edition")
        .Columns(2).ClearContents
        .Cells(2, 2).Value = Cel.Text
        [COLOR=NAVY]For[/COLOR] L = 1 [COLOR=NAVY]To[/COLOR] Sportifs.Count
            .Cells(L + 3, 2).Value = Sportifs(L)
        [COLOR=NAVY]Next[/COLOR] L
    [COLOR=NAVY]End With
End Sub[/COLOR]
Cordialement,
 

Pièces jointes

  • mDF_Sportifs.zip
    17.1 KB · Affichages: 23

legrand.slb

XLDnaute Nouveau
Re : Macro évémentielle : Création d'une liste à partir de 2 tableaux

Bonjour

Merci pour ta réponse "nocturne".
Je débute sur VBA et j’ai beaucoup de peine à adapter ton code à mon fichier
Je joins un extrait du fichier d’origine et le résultat attendu dans les onglets « Edition »
Merci de ton aide si tu as le temps
Cdt
Bertrand
 

Pièces jointes

  • Test proced.zip
    41.4 KB · Affichages: 16

myDearFriend!

XLDnaute Barbatruc
Re : Macro évémentielle : Création d'une liste à partir de 2 tableaux

Bonsoir legrand.slb, le Forum,

Legrand.slb à dit:
Je débute sur VBA et j’ai beaucoup de peine à adapter ton code à mon fichier
Et pour cause... le fichier est bien différent de l'exemple que tu as fourni plus haut....:confused:

Je viens donc de recommencer une adaptation du code pour le fichier que tu trouveras ci-joint modifié.

La procédure devient :
Code:
[COLOR=GRAY][B][I]DANS UN MODULE DE CODE STANDARD[/I][/B][/COLOR]

[COLOR=NAVY]Option Explicit[/COLOR]

[COLOR=NAVY]Sub[/COLOR] Traitement(Cel [COLOR=NAVY]As[/COLOR] Range)
[COLOR=GREEN]'myDearFriend! - www.mdf-xlpages.com[/COLOR]
[COLOR=NAVY]Dim[/COLOR] Operateurs [COLOR=NAVY]As Object
Dim[/COLOR] Result [COLOR=NAVY]As[/COLOR] Range
[COLOR=NAVY]Dim[/COLOR] TabTemp [COLOR=NAVY]As Variant[/COLOR], N [COLOR=NAVY]As Variant[/COLOR], S [COLOR=NAVY]As Variant
Dim[/COLOR] Ateliers [COLOR=NAVY]As String[/COLOR], Atelier [COLOR=NAVY]As String
Dim[/COLOR] L [COLOR=NAVY]As Long
Dim[/COLOR] C [COLOR=NAVY]As Integer
Dim[/COLOR] Car [COLOR=NAVY]As Byte[/COLOR]
    [COLOR=GREEN]'Extrait les ateliers concernés (sans séparateur)[/COLOR]
    Ateliers = Replace(Cel.Offset(0, -3).Text, "-", "")
    [COLOR=NAVY]With[/COLOR] Sheets("Opérateurs")
        [COLOR=GREEN]'Mémorise le tableau des opérateurs[/COLOR]
        C = .Range("IV2").[COLOR=NAVY]End[/COLOR](xlToLeft).Column
        L = .Range("A65536").[COLOR=NAVY]End[/COLOR](xlUp).Row
        TabTemp = .Range(.Cells(2, 1), .Cells(L, C)).Value
        [COLOR=NAVY]Set[/COLOR] Operateurs = CreateObject("Scripting.Dictionary")
        [COLOR=GREEN]'Pour chaque Atelier à trouver[/COLOR]
        [COLOR=NAVY]For[/COLOR] Car = 1 [COLOR=NAVY]To[/COLOR] Len(Ateliers) [COLOR=NAVY]Step[/COLOR] 2
            Atelier = Mid(Ateliers, Car, 2)
                [COLOR=NAVY]For[/COLOR] C = 3 [COLOR=NAVY]To UBound[/COLOR](TabTemp, 2)
                    [COLOR=NAVY]If[/COLOR] TabTemp(1, C) = Atelier [COLOR=NAVY]Then
                        For[/COLOR] L = 5 [COLOR=NAVY]To UBound[/COLOR](TabTemp, 1)
                            [COLOR=NAVY]If[/COLOR] TabTemp(L, C) <> "" [COLOR=NAVY]Then[/COLOR]
                                [COLOR=GREEN]'"Collecte" les statuts et noms des opérateurs (sans doublon)[/COLOR]
                                [COLOR=NAVY]On Error Resume Next[/COLOR]
                                Operateurs.Add TabTemp(L, 2), TabTemp(L, 1)
                                [COLOR=NAVY]On Error GoTo[/COLOR] 0
                            [COLOR=NAVY]End If
                        Next[/COLOR] L
                        [COLOR=NAVY]Exit For
                    End If
                Next[/COLOR] C
        [COLOR=NAVY]Next[/COLOR] Car
    [COLOR=NAVY]End With[/COLOR]
    [COLOR=GREEN]'MAJ résultats[/COLOR]
    [COLOR=NAVY]With[/COLOR] Sheets("Edition Nom")
        [COLOR=NAVY]Set[/COLOR] Result = .Range("A8:B65536")
        Result.ClearContents
        .Cells(2, 2).Value = Cel.Text
        S = Operateurs.items
        N = Operateurs.keys
        [COLOR=NAVY]For[/COLOR] L = 0 [COLOR=NAVY]To[/COLOR] Operateurs.Count - 1
            .Cells(L + 8, 1).Value = S(L)   [COLOR=GREEN]'Statuts[/COLOR]
            .Cells(L + 8, 2).Value = N(L)   [COLOR=GREEN]'Noms[/COLOR]
        [COLOR=NAVY]Next[/COLOR] L
        Result.Sort Key1:=.Range("A8"), Order1:=xlAscending, Key2:=.Range("B8") _
            , Order2:=xlAscending
    [COLOR=NAVY]End With
End Sub[/COLOR]
Je ne me suis occupé que de la mise à jour de l'onglet "Edition Nom".

Cordialement,
 

Pièces jointes

  • mDF_Test proced.zip
    46.8 KB · Affichages: 34

legrand.slb

XLDnaute Nouveau
Re : Macro évémentielle : Création d'une liste à partir de 2 tableaux

Bonjour Didier
C'est absolument parfait
Maintenant, tous mes tableaux se croisent dans tous les sens.
Il ne me reste plus que la mise en page
Le nombre de noms dans chaque statut étant toujours différent selon les extractions, je n’arrive pas à tester les différents blocs pour les séparer et les entourer.
Je cherche à réaliser le modèle joint …………………. si ce n’est pas trop abuser.
Encore merci
Bertrand
 

Pièces jointes

  • Test proced2.zip
    26.9 KB · Affichages: 16
Dernière édition:

myDearFriend!

XLDnaute Barbatruc
Re : Macro évémentielle : Création d'une liste à partir de 2 tableaux

Bonsoir legrand.slb, le Forum,

Ci-joint le classeur précédent adapté en fonction de ta dernière demande.

J'attire toutefois ton attention sur la mise en forme des résultats telle que souhaitée... Plus agréable à l'oeil, certe, elle nécessite toutefois du code VBA à outrance. En terme de mise en forme, on peut tout faire grâce au code, mais si tu souhaites ajouter de l'automatisme au traitement, il faut également savoir adapter la mise en forme au besoin. C'est un choix à faire, surtout si tu ne veux pas voir ton projet se transformer peu à peu en usine à gaz infâme et trop complexe pour pouvoir être modifiée par la suite...

Bonne continuation.

Cordialement,
 

Pièces jointes

  • mDF_Test proced2.zip
    46.5 KB · Affichages: 23

legrand.slb

XLDnaute Nouveau
Re : Macro évémentielle : Création d'une liste à partir de 2 tableaux

Bonsoir Didier
Mon projet est terminé ..............et fonctionne parfaitement avec un temps de réponse < 1 seconde
Un grand merci pour les lignes de codes et les conseils.
Cdt
Bertrand
 

Discussions similaires