Macro pour fichier complexe avec des recherches à plusieurs critères

josef140

XLDnaute Nouveau
Bonjour,

Je suis débutant dans la programmation VBA j'aimerais savoir si quelqu'un aurait déjà un code qui me facilite le travail.

Mon problème et le suivant j'ai un tableau exporté avec une macro, et plusieurs onglets je dois rechercher des données avec 4 critères et les mettre dans les tableaux présents dans les onglets.

J'ai essayé avec index et equiv mais le fichiers devient trop lourd est je ne peux pas créer des graphes après.

donc j'ai ce tableau que je charge avec une macro qui représente des données de plusieurs fichiers csv.
date heure cote 7,95 cote9,14 machine type de prélèv équipe jour
12/05/2014 06:41:49 7,939 9,137 32 Fréquence controle M 2
12/05/2014 06:43:08 7,941 9,131 32 Fréquence controle M 2
12/05/2014 06:44:21 7,941 9,133 32 Fréquence controle M 2
12/05/2014 17:34:45 7,94 9,131 32 Réglage AM 2
12/05/2014 06:26:42 7,944 9,128 54 Fréquence controle M 2
12/05/2014 06:27:54 7,942 9,126 54 Fréquence controle M 2
12/05/2014 06:29:13 7,944 9,128 54 Fréquence controle M 2
12/05/2014 17:30:47 7,941 9,135 54 Fréquence controle AM 2
12/05/2014 17:32:56 7,941 9,135 54 Réglage AM 2

et je dois remplir les 12 tableaux (1 par onglet) ex machine 32 pour la côte 7,95:

Contrôle 1 Contrôle 2 Contrôle 3 Contrôle 4 Réglage 1 Réglage 2
Lundi M 7,939 7,941 7,941
AM 7,94( cette valeur doit etre dans la celulle(réglage1 ,AM)
N
Mardi M
AM
N
Mercredi M
AM
N
Jeudi M
AM
N
Vendredi M
AM
N

Donc une recherche avec 4 critères: machine, type de prélèv, équipe, jour et venir affecter la cote mesurée dans les tableaux qui sont par machin et côte exemple le tableau ci-dessus machine32/côte7,95.

Je joint le fichier pour mieux comprendre et je vous remercie vivement pour votre aide et votre temps.
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro pour fichier complexe avec des recherches à plusieurs critères

Bonsoir Josef, bonsoir le forum,

Si j'ai bien compris...
En pièce jointe ton fichier modifié avec un bouton Traiter les données pour lancer le code ci-dessous :
Code:
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage des cellules Visibles)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim OD1 As Object 'déclare la variable OD1 (Onglet de Destination 1)
Dim OD2 As Object 'déclare la variable OD2 (Onglet de Destination 2)
Dim I As Integer 'déclare la variable I (Incrément de machine)
Dim J As Byte 'déclare la variable J (incrément de Jour)
Dim COL As Byte 'déclare la variable COL (COLonne)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Sheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 5).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 5 (=E) de l'onglet O
Set PL = O.Range("E2:E" & DL) 'définit la plage PL
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    D(CEL.Value) = "" 'alimente le dictionnaire D
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste sans doublons des machines de la colonne E
For I = 0 To UBound(TMP) 'boucle 1 : sur toutes les machines du tableau temporaire TMP
    Set OD1 = Sheets(TMP(I) & "-7,95") 'définit l'onglet OD1
    Set OD2 = Sheets(TMP(I) & "-9,14") 'définit l'onglet OD2
    For J = 2 To 6 'boucle 2 : de 2 à 6 sur les 5 jours (du lundi au vendredi)
        O.Range("A1").AutoFilter 'supprime un éventuel filtre existant
        O.Range("A1").AutoFilter Field:=5, Criteria1:=TMP(I) 'filtre la colonne E par rapport à la machine TMP(I) de la boucle 1
        O.Range("A1").AutoFilter Field:=8, Criteria1:=J 'filtre la colonne H par rapport au jour J de la boucle 2
        O.Range("A1").AutoFilter Field:=7, Criteria1:="M" 'filtre la colonne G par rapport au critère "M"
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        'cette ligne génère une erreur si les filtres n'affichent aucune ligne visible
        Set PLV = PL.SpecialCells(xlCellTypeVisible).Offset(0, -2) 'définit la plage PLV (cellulles de la plage PL visibles en colonne C)
        If Err <> 0 Then Err.Clear: GoTo suite1 'si une erreur a été générée, annule l'erreur, va à l'étiquette "suite1"
        COL = 5 'initialise la colonne COL
        For Each CEL In PLV 'boucle 3 : sur toutes les cellules CEL de la plage PLV
            'récupère la valeur "7,95" et la place en fonction du jour J dans l'onglet OD1
            OD1.Cells((2 * J) + (J - 2), COL).Value = CEL.Value
            'récupère la valeur "9,14" et la place en fonction du jour J dans l'onglet OD2
            OD2.Cells((2 * J) + (J - 2), COL).Value = CEL.Offset(0, 1).Value
            COL = COL + 1 'incrémente la colonne COL
        Next CEL 'prochaine cellule de la boucle 3
suite1: 'étiquette
        O.Range("A1").AutoFilter Field:=7, Criteria1:="AM" 'filtre la colonne G par rapport au critère "AM"
        'cette ligne génère une erreur si les filtres n'affichent aucune ligne visible
        Set PLV = PL.SpecialCells(xlCellTypeVisible).Offset(0, -2) 'définit la plage PLV (cellulles de la plage PL visibles en colonne C)
        If Err <> 0 Then Err.Clear: GoTo suite2 'si une erreur a été générée, annule l'erreur, va à l'étiquette "suite2"
        COL = 5 'initialise la colonne COL
        For Each CEL In PLV 'boucle 4 : sur toutes les cellules CEL de la plage PLV
            'récupère la valeur "7,95" et la place en fonction du jour J dans l'onglet OD1
            OD1.Cells((2 * J) + (J - 1), COL).Value = CEL.Value
            'récupère la valeur "9,14" et la place en fonction du jour J dans l'onglet OD2
            OD2.Cells((2 * J) + (J - 1), COL).Value = CEL.Offset(0, 1).Value
            COL = COL + 1 'incrémente la colonne COL
        Next CEL 'prochaine cellule de la boucle 4
suite2: 'étiquette
        O.Range("A1").AutoFilter Field:=7, Criteria1:="N" 'filtre la colonne G par rapport au critère "N"
        'cette ligne génère une erreur si les filtres n'affichent aucune ligne visible
        Set PLV = PL.SpecialCells(xlCellTypeVisible).Offset(0, -2) 'définit la plage PLV (cellulles de la plage PL visibles en colonne C)
        If Err <> 0 Then Err.Clear: GoTo suite3 'si une erreur a été générée, annule l'erreur, va à l'étiquette "suite3"
        COL = 5 'initialise la colonne COL
        For Each CEL In PLV 'boucle 5 : sur toutes les cellules CEL de la plage PLV
            'récupère la valeur "7,95" et la place en fonction du jour J dans l'onglet OD1
            OD1.Cells((2 * J) + J, COL).Value = CEL.Value
            'récupère la valeur "9,14" et la place en fonction du jour J dans l'onglet OD2
            OD2.Cells((2 * J) + J, COL).Value = CEL.Offset(0, 1).Value
            COL = COL + 1 'incrémente la colonne COL
        Next CEL 'prochaine cellule de la boucle 5
suite3: 'étiquette
    Next J 'prochain jour de la boucle 2
Next I 'prochaine machine de la boucle 1
O.Range("A1").AutoFilter 'supprime le filtre automatique
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Données traitées !" 'message
End Sub
Le fichier :
 

Pièces jointes

  • Josef_v01.xlsm
    81.3 KB · Affichages: 35

josef140

XLDnaute Nouveau
Re : Macro pour fichier complexe avec des recherches à plusieurs critères

Bonsoir Robert,

J'ai réussi avec des filtre mais bon ça prend 15 minutes sinon votre macro marche très bien j'ai juste une question si je rajoute une colonne contrôle et une réglage au cas ou je dois changer quelle ligne ? merci bcp!

Cordialement.
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro pour fichier complexe avec des recherches à plusieurs critères

Bonsoir Joseh, bonsoir le forum,

Normalement aucune mais encore une fois je ne sais pas si j'ai bien compris le principe. Le code filtre d'abord la machine, puis le jour puis l'équipe... En fonction du nombre de lignes affichées il renvoie les données en décalant chaque fois d'une colonne à droite. Mais j'avoue ne pas avoir compris la différence entre un contrôle et un Réglage...
 

josef140

XLDnaute Nouveau
Re : Macro pour fichier complexe avec des recherches à plusieurs critères

Rebonsoir robert En faite il y a un problème car par exemple pour cette ligne (ci-dessous) la macro l'affecte à un réglage alors qu'il s'agit d'un contrôle: 14/05/2014 10:54:13 7,939 9,135 32 Fréquence controle M 4

Le contrôle et le réglage sont deux paramètres totalement différent , est ce que c'est possible de dissocier entre ces deux paramètres avec votre macro ?càd s'il s'agit d'un contrôle on l'affecte au 5 premières colonnes sinon on décale pour l'affecter au colonne réglage 3 si possible.

Merci !
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro pour fichier complexe avec des recherches à plusieurs critères

Bonsoir Josef, bonsoir le forum,

Oui ça y est j'ai compris et j'ai vu mon erreur... Mais je regarde ça demain car là je vais me coucher...
 

Robert

XLDnaute Barbatruc
Repose en paix
Re : Macro pour fichier complexe avec des recherches à plusieurs critères

Bonsoir Josef, bonsoir le forum,

La version 2 avec deux Contrôles supplémentaires et un Réglage en plus. Car si on veut tout traiter la machine 54 a 6 valeurs de fréquences de contrôles le mercredi... Le code modifié :
Code:
Sub Macro1()
Dim O As Object 'déclare la variable O (Onglet)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage des cellules Visibles)
Dim D As Object 'déclare la variable D (Dictionnaire)
Dim CEL As Range 'déclare la variable CEL (CELlule)
Dim TMP As Variant 'déclare la variable TMP (tableau TeMPoraire)
Dim OD1 As Object 'déclare la variable OD1 (Onglet de Destination 1)
Dim OD2 As Object 'déclare la variable OD2 (Onglet de Destination 2)
Dim I As Integer 'déclare la variable I (Incrément de machine)
Dim J As Byte 'déclare la variable J (incrément de Jour)
Dim COL As Byte 'déclare la variable COL (COLonne)
Dim C As Byte 'déclare la variable C (Type Contrôle))
Dim R As Byte 'déclare la variable R (type Réglage)

Application.ScreenUpdating = False 'masque les rafraîchissements d'écran
Set O = Sheets("Feuil1") 'définit l'onglet O
DL = O.Cells(Application.Rows.Count, 5).End(xlUp).Row 'définit la dernière ligne éditée DL de la colonne 5 (=E) de l'onglet O
Set PL = O.Range("E2:E" & DL) 'définit la plage PL
Set D = CreateObject("Scripting.Dictionary") 'définit le dictionnaire D
For Each CEL In PL 'boucle sur toutes les cellules CEL de la plage PL
    D(CEL.Value) = "" 'alimente le dictionnaire D
Next CEL 'prochaine cellule de la boucle
TMP = D.keys 'récupère dans le tableau temporaire TMP la liste sans doublons des machines de la colonne E
For I = 0 To UBound(TMP) 'boucle 1 : sur toutes les machines du tableau temporaire TMP
    Set OD1 = Sheets(TMP(I) & "-7,95") 'définit l'onglet OD1
    Set OD2 = Sheets(TMP(I) & "-9,14") 'définit l'onglet OD2
    For J = 2 To 6 'boucle 2 : de 2 à 6 sur les 5 jours (du lundi au vendredi)
        O.Range("A1").AutoFilter 'supprime un éventuel filtre existant
        O.Range("A1").AutoFilter Field:=5, Criteria1:=TMP(I) 'filtre la colonne E par rapport à la machine TMP(I) de la boucle 1
        O.Range("A1").AutoFilter Field:=8, Criteria1:=J 'filtre la colonne H par rapport au jour J de la boucle 2
        O.Range("A1").AutoFilter Field:=7, Criteria1:="M" 'filtre la colonne G par rapport au critère "M"
        On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
        'cette ligne génère une erreur si les filtres n'affichent aucune ligne visible
        Set PLV = PL.SpecialCells(xlCellTypeVisible).Offset(0, -2) 'définit la plage PLV (cellulles de la plage PL visibles en colonne C)
        If Err <> 0 Then Err.Clear: GoTo suite1 'si une erreur a été générée, annule l'erreur, va à l'étiquette "suite1"
        C = 5: R = 11 'initialise les variables C et R
        For Each CEL In PLV 'boucle 3 : sur toutes les cellules CEL de la plage PLV
            COL = IIf(CEL.Offset(0, 3).Value = "Réglage", R, C) 'définit la colonne COL en fonction du type
            'récupère la valeur "7,95" et la place en fonction du jour J dans l'onglet OD1
            OD1.Cells((2 * J) + (J - 2), COL).Value = CEL.Value
            'récupère la valeur "9,14" et la place en fonction du jour J dans l'onglet OD2
            OD2.Cells((2 * J) + (J - 2), COL).Value = CEL.Offset(0, 1).Value
            'incrémente les variables C et R
            C = IIf(CEL.Offset(0, 3).Value = "Réglage", C, C + 1): R = IIf(CEL.Offset(0, 3).Value = "Réglage", R + 1, R)
        Next CEL 'prochaine cellule de la boucle 3
suite1: 'étiquette
        O.Range("A1").AutoFilter Field:=7, Criteria1:="AM" 'filtre la colonne G par rapport au critère "AM"
        'cette ligne génère une erreur si les filtres n'affichent aucune ligne visible
        Set PLV = PL.SpecialCells(xlCellTypeVisible).Offset(0, -2) 'définit la plage PLV (cellulles de la plage PL visibles en colonne C)
        If Err <> 0 Then Err.Clear: GoTo suite2 'si une erreur a été générée, annule l'erreur, va à l'étiquette "suite2"
        C = 5: R = 11 'initialise les variables C et R
        For Each CEL In PLV 'boucle 4 : sur toutes les cellules CEL de la plage PLV
            COL = IIf(CEL.Offset(0, 3).Value = "Réglage", R, C) 'définit la colonne COL en fonction du type
            'récupère la valeur "7,95" et la place en fonction du jour J dans l'onglet OD1
            OD1.Cells((2 * J) + (J - 1), COL).Value = CEL.Value
            'récupère la valeur "9,14" et la place en fonction du jour J dans l'onglet OD2
            OD2.Cells((2 * J) + (J - 1), COL).Value = CEL.Offset(0, 1).Value
            'incrémente les variables C et R
            C = IIf(CEL.Offset(0, 3).Value = "Réglage", C, C + 1): R = IIf(CEL.Offset(0, 3).Value = "Réglage", R + 1, R)
        Next CEL 'prochaine cellule de la boucle 4
suite2: 'étiquette
        O.Range("A1").AutoFilter Field:=7, Criteria1:="N" 'filtre la colonne G par rapport au critère "N"
        'cette ligne génère une erreur si les filtres n'affichent aucune ligne visible
        Set PLV = PL.SpecialCells(xlCellTypeVisible).Offset(0, -2) 'définit la plage PLV (cellulles de la plage PL visibles en colonne C)
        If Err <> 0 Then Err.Clear: GoTo suite3 'si une erreur a été générée, annule l'erreur, va à l'étiquette "suite3"
        C = 5: R = 11 'initialise les variables C et R
        For Each CEL In PLV 'boucle 5 : sur toutes les cellules CEL de la plage PLV
            COL = IIf(CEL.Offset(0, 3).Value = "Réglage", R, C) 'définit la colonne COL en fonction du type
            'récupère la valeur "7,95" et la place en fonction du jour J dans l'onglet OD1
            OD1.Cells((2 * J) + J, COL).Value = CEL.Value
            'récupère la valeur "9,14" et la place en fonction du jour J dans l'onglet OD2
            OD2.Cells((2 * J) + J, COL).Value = CEL.Offset(0, 1).Value
            'incrémente les variables C et R
            C = IIf(CEL.Offset(0, 3).Value = "Réglage", C, C + 1): R = IIf(CEL.Offset(0, 3).Value = "Réglage", R + 1, R)
        Next CEL 'prochaine cellule de la boucle 5
suite3: 'étiquette
    Next J 'prochain jour de la boucle 2
Next I 'prochaine machine de la boucle 1
O.Range("A1").AutoFilter 'supprime le filtre automatique
Application.ScreenUpdating = True 'affiche les rafraîchissements d'écran
MsgBox "Données traitées !" 'message
End Sub
Si tu dois rajouter des Contrôles ou des Réglages il te faudra adapter les trois lignes identiques :
Code:
C = 5: R = 11 'initialise les variables C et R
C est la valeur de la première colonne de Contrôle et R la valeur de la première colonne de Réglage...

Le fichier :
 

Pièces jointes

  • Josef_v02.xlsm
    83.6 KB · Affichages: 32

Statistiques des forums

Discussions
312 095
Messages
2 085 248
Membres
102 835
dernier inscrit
Alexandrax971