Microsoft 365 extraction de données d'un tableau

[Bob 31]

Bonjour

J'ai un tableau avec des macros et une extraction par mois et je souhaiterai que l'extraction se fasse par mois comme c'est le cas mais en classant le résultat comme pour l'exemple que j'ai inscrit sur l'onglet "JANVIER"
Je souhaiterai que sur la première colonnes soit copier les matricules (autant de ligne que de besoin 21 je penses), sur la deuxième colonnes les libellés en fluo (.HBA .TH etc...) et sur la troisième colonne le résultat pour chaque matricules et libellés.

En vous remerciant pour votre aide

Cordialement

 

[Robert]

Bonjour Bob et bienvenu, bonjour le forum,

En pièce jointe ton fichier modifié avec le code ci-dessous :

Private Sub btnExtraction_click()
Dim OA As Worksheet 'déclare la variable OA (Onglet Année)
Dim TET(1 To 21) As String 'déclare le tableau de 21 variables TET (Tableau des En-Têtes)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Integer 'déclare la variable L (incrément)
Dim OM As Worksheet 'déclare la variable OM (Onglet Mois)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Application.ScreenUpdating = False 'masque les raffraîchissements d'écran
Set OA = Worksheets("ANNEE") 'définit l'onglet OA
TET(1) = ".HBA" 'définit l'en-tête TET(1)
TET(2) = ".TH" 'définit l'en-tête TET(2)
TET(3) = ".TTE" 'définit l'en-tête TET(3)
TET(4) = "BCOU" 'définit l'en-tête TET(4)
TET(5) = "BAMP" 'définit l'en-tête TET(5)
TET(6) = ".HCO" 'définit l'en-tête TET(6)
TET(7) = ".HS1" 'définit l'en-tête TET(7)
TET(8) = ".HS2" 'définit l'en-tête TET(8)
TET(9) = "BC" 'définit l'en-tête TET(9)
TET(10) = "BTDN" 'définit l'en-tête TET(10)
TET(11) = "BSD" 'définit l'en-tête TET(11)
TET(12) = "BSD2" 'définit l'en-tête TET(12)
TET(13) = "BJF" 'définit l'en-tête TET(13)
TET(14) = "BJF2" 'définit l'en-tête TET(14)
TET(15) = "BRE" 'définit l'en-tête TET(15)
TET(16) = "BAST" 'définit l'en-tête TET(16)
TET(17) = "BH24" 'définit l'en-tête TET(17)
TET(18) = "BPE" 'définit l'en-tête TET(18)
TET(19) = "B13" 'définit l'en-tête TET(19)
TET(20) = ".ACO" 'définit l'en-tête TET(20)
TET(21) = ".C.C" 'définit l'en-tête TET(21)
TV = OA.Range("A1").CurrentRegion 'définit le tableau des valeurss TV
For I = 2 To UBound(TV, 1) 'boucle 1 : sur toutes les lignes I du tableau des valeurs TV (en partant de la seconde)
    If TV(I, 1) = Me.ComboRegion.Value Then 'condition 1 : si la donnée ligne I colonne 1 de TV est égale à la valeur de la combobox [ComboRegion]
        On Error Resume Next 'gestion des erreurs (e cas d'erreur passe à la ligne suivante)
        Set OM = Worksheets(Me.ComboRegion.Value) 'définit l'onglet du mois OM (génère une erreur si cet onglet n'existe pas)
        If Err <> 0 Then 'condition 2 : si une erreur a été générée
            Err.Clear 'supprime l'erreur
            Worksheets.Add before:=Worksheets("ANNEE") 'ajoute une onglet vierge avant l'onglet "ANNEE"
            Set OM = ActiveSheet 'définit l'onglet OM
            OM.Name = Me.ComboRegion.Value 'nomme l'onglet OM
        End If 'fin de la condition 2
        For J = 1 To 21 'boucle 2 : sur les 21 en-têtes J
            For L = 6 To UBound(TV(I, 2)) 'boucle 3 : sur toutes les colonne L du tableau des valeurs (en partant de la 6ème)
                If TV(1, L) = TET(J) Then 'condition3 : si la donnée ligne 1 colonne L de TV est égale à l'en-tête TET(J)
                    K = K + 1 'incrémente K
                    ReDim Preserve TL(1 To 3, 1 To K) 'redimensionne le tableau des lignes TL(3 lignes, K colonnes)
                    TL(1, K) = TV(I, 3) 'récupère dans la ligne 1 de TL la donnée en colonne 3 de TV
                    TL(2, K) = TET(J) 'récupère dans la ligne 2 de TL l'en-tête TET(J)
                    TL(3, K) = OA.Cells(I, OA.Rows(1).Find(TET(J), , xlValues, xlWhole).Column).Value 'récupère dans la ligne 3 de TL la valeur de la cellule ligne I, colonne = recheche exacte de TET(J) dans la ligne 1 de l'onglet OA
                    Exit For 'sort de la boucle 3
                End If 'fin de la condition 3
            Next L 'prochaine colonne de la boucle 3
        Next J 'prochaine en-tête de la boucle 2
    End If 'fin de la condition 1
Next I 'prochaine ligne de la boucle 1
Unload Me 'vide et ferme l'UserForm en cours
With OM 'prend en compte l'ongelt OM
    .Cells.ClearContents 'efface toutes les cellules
    .Range("A1").Value = "MATRICULE" 'écrit en A1
    .Range("C1").Value = "NOMBRE" 'écrit en C1
    'si K est supérieure à zéro, renvoie le tableau TL transposé dans A2 redimensionnée
    If K > 0 Then .Range("A2").Resize(K, 3).Value = Application.Transpose(TL)
    .Columns(3).NumberFormat = "0.00" 'format de la colonne C de l'onglet OM
    .Activate 'active l'onglet
End With 'fin de la prise en compte de l'onglet OM
Application.ScreenUpdating = True    'affiche les raffraîchissements d'écran
MsgBox "Données traitées !" 'message
End Sub

Le fichier :

 

[Bob 31]

Bonsoir Robert

Vraiment trop fort
Vous m'avez bien aidé, je n'ai pas du tout votre niveau et maitrise
Je l'essaye et le met en place
Je me permettrais de revenir vers vous pour précision
Un grand merci pour votre aide
A très bientôt
Cordialement

Bob

 

[Bob 31]

Bonsoir Robert
L'extraction fonctionne bien mais j'aimerai l'améliorer au vu de l'utilisation :
Sur l'extraction je souhaiterai supprimer de la première ligne le libellé " matricule et nombre" et débuter directement par

AF

.HBA

151,67​

Je ne sais si c'est possible mais je souhaiterai également ne pas extraire les matricules lignes et les résultats des matricules nommés : #REF!

Pour les résultats des nombres est il possible de déterminer le nombre de décimales après la virgule dans la programmation suivant les 21 éléments :

.HBA

.TH

.TTE

BCOU

BAMP

.HCO

.HS1

.HS2

BC

BTDN

BSD

BSD2

BJF

BJF2

BRE

BAST

BH24

BPE

B13

.ACO

.C.C

Si un jour je veux supprimer la ligne et le résultat de : TET(19) = "B13" 'définit l'en-tête TET(19) est ce qu'il faut que je supprime cela dans la programmation ainsi que de renommer les ligne suivantes (19) puis (20) et remplacer For J = 1 To 21 'boucle 2 : sur les 21 en-têtes J
par : For J = 1 To 20 'boucle 2 : sur les 20 en-têtes J

Merci encore et bonne soirée
A très bientôt
Bob 31

 

[Bob 31]

Bonjour ci joint un tableau ou Robert m'a mis au point la macro d'extraction

L'extraction fonctionne bien mais j'aimerai amener des modifications au vu de l'utilisation :
Je souhaiterai que les résultats de l'extraction puissent être mis à jour et garder le lien avec les données de l'onglet année.

Sur l'extraction je souhaiterai supprimer de la première ligne le libellé " matricule et nombre" et débuter directement par

AF

.HBA

151,67

Je souhaiterai également ne pas extraire les matricules lignes et les résultats des matricules nommés : #REF! et ne pas extraire le matricule si l'ensemble des libellés donne comme résultat du nombre 0 ou non renseigné (vide)

Pour les résultats des nombres est il possible de déterminer le nombre de décimales après la virgule dans la programmation suivant les 21 éléments :

.HBA

.TH

.TTE

BCOU

BAMP

.HCO

.HS1

.HS2

BC

BTDN

BSD

BSD2

BJF

BJF2

BRE

BAST

BH24

BPE

B13

.ACO

.C.C

Merci encore et bonne journée
A très bientôt
Bob 31