Cumul par magasin qui repond a un critère dans un tableau VBA

Le 20/05/2020 à 22:31

Bonsoir à tous,

Pas sûr que le titre soit top...

Comme beaucoup de personnes ici, je rencontre un petit soucis sur une programme de macro VBA.

Je vais donc vous présenter mes docs et l'objectif final.

Base de données : Base PGM LR0 (en Pièce jointe)

J'ai une base de donnée très lourde qui se nomme Base PGM LR0.xlsx (très allégé pour les besoins du services et anonymisée. Ca peut donc paraitre incohérent mais la structure est bien identique ).

La feuille PGM 2 contient normalement plus de 880000 lignes (données entre 2017 et 2020 donc il manque encore la moitié de l'année 2020)

La feuille PGM 5 contient nettement moins de données. On est dans l'ordre des 7000 lignes où il manque aussi la moitié de l'année 2020).

Le document est structuré de la manière suivante (et est extrait d'un requêteur) :

2 feuilles PGM CL2 et PGM CL5 constitué de la même manière

Date en jj/mm/aaaa (format: Texte)

Magasin : 2 positions

Unité : entre 2 et 3 positions

Type Catalogue: 1 position => inutile dans la requete

Lib Catalogue : => inutile dans la requete

Nb: Il n'est pas forcément égal à 1

Mt -> inutile dans la requête

Mt après -> Inutile dans la requête

Ecart -> Inutile dans la requête

Id client -> Inutile dans la requête

Fichier de résultat

Il n'est pas fourni car il y aurait beaucoup de chose a anonymiser... mais le principe est qu'il s'appelle "TDB PGM.xlsm" et qu'il a une feuille qui se nomme "Top 10 magasins"

Objectif:

  • Établir un top 10 par magasin du nombre de vente.
  • Je permet à l'utilisateur de préciser l'année concerné par le top (ex: 2020)
  • Je ne connais pas le nombre de magasins existants dans la base. Je ne peux donc pas établir un tableau que je remplirais avec une boucle.
  • Il s'agit d'un top magasin qui cumule les deux feuilles (PGM 2 et PGM 5)

Méthode envisagée

Pour cela, j'ai fais un tableau (array ? J'ai un doute sur le fait que ce soit exactement la même chose... je découvre un peu ce type de fabrication) dans lequel j'insère ma première feuille (PGM 2) et à la suite ma deuxième feuille (PGM 5). (Vu que c'est la première fois que j'insère deux feuilles dans un même tableau, j'espère que ça marche )

Je boucle dans le tableau pour faire les cumuls, je supprime les doublons éventuel, je classe par ordre décroissant sur le "Nb" et pour chaque magasin, j'écris dans une page blanche : L'année / Le magasin / Le Nb

Je me dis qu'en théorie, ça à l'air d'être pertinent, mais n'hésitez pas à me contredire si ça ne l'est pas.

Voici le premier bout de code qui va chercher le fichier Base de donnée et qui est donc appelé au début de l'autre script.

Option Explicit

Public EmplacementDossier As String
Public Afichier_Base_LR As String
Public Afichier_Base_Ajust As String
Public LongueurEmplacementDossier As Long
Public NFichier_LR As String
Public Nfichier_Ajust As String
Public Nfichier_TDB As String

Public Function AttributionChemin() As String

EmplacementDossier = "C:\Users\xxxx\Desktop\Stats LR\"
NFichier_LR = Dir(EmplacementDossier & "Base PGM LR*" & ".xlsx")
Nfichier_Ajust = Dir(EmplacementDossier & "Ajust-_Suivi*" & ".xlsx")

Afichier_Base_LR = EmplacementDossier + NFichier_LR
Afichier_Base_Ajust = EmplacementDossier + Nfichier_Ajust
Nfichier_TDB = "TDB PGM.xlsm"

End Function

Voici le deuxième bout de code avec l'insertion des feuilles de la base dans un tableau. Ce code est normalement dans un formulaire d'où le click dans le nom.

Option Explicit

Option Base 1

Private Sub B_Annuel_Click()

Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

' On appelle la fonction AttributionChemin pour attribuer les noms et emplacements des fichiers dans la macro en cours
Call AttributionChemin

Dim S_LR2Derniereligne As Long
Dim S_LR5Derniereligne As Long
Dim S_tableauLR() As Variant
Dim Dde_Maj As String
Dim Taille_Dde As Long
Dim Taille_DdeLR5 As Long
Dim Taille_DdeLR2 As Long
Dim ligne_insertion As Long
Dim B_NbLR As Long
Dim ValeurColonneA As String
Dim i As Long
Dim j As Long

' Fenetre qui demande la période

Dde_Maj = InputBox("Veuillez préciser l'année concernée pour le top que vous souhaitez mettre à jour (format: aaaa)", "Mise à jour Top Magasin")

'
' Import et traitement du fichier PGM LR
'

' Si le nom du fichier est différent de rien
If Afichier_Base_LR <> "" Then

    ' Alors j'ouvre le fichier Afichier_Base_LR
    Workbooks.Open Filename:=Afichier_Base_LR

    ' Calcul de la dernière ligne du tableau PGM 2
    S_LR2Derniereligne = Workbooks(NFichier_LR).Sheets("PGM Cl2").Range("A" & Rows.Count).End(xlUp).Row
    ' Calcul de la dernière ligne du tableau PGM 5
    S_LR5Derniereligne = Workbooks(NFichier_LR).Sheets("PGM Cl5").Range("A" & Rows.Count).End(xlUp).Row

    ' On retravaille les formats de la base PGM
    ' Colonne A en format texte
    Workbooks(NFichier_LR).Sheets("PGM Cl2").Columns("A:A").NumberFormat = "@"
    Workbooks(NFichier_LR).Sheets("PGM Cl5").Columns("A:A").NumberFormat = "@"

    For i = 1 To S_LR2Derniereligne
        ' on supprime les espaces en colonne A
        Workbooks(NFichier_LR).Sheets("PGM Cl2").Range("A" & i).Value = Trim(Workbooks(NFichier_LR).Sheets("PGM Cl2").Range("A" & i).Value)
    Next i

    For j = 1 To S_LR5Derniereligne
        ' on supprime les espaces en colonne A
        Workbooks(NFichier_LR).Sheets("PGM Cl5").Range("A" & j).Value = Trim(Workbooks(NFichier_LR).Sheets("PGM Cl5").Range("A" & j).Value)
    Next j

    ' On compte le nombre de valeur qui correspond à la saisie de l'utilisateur pour dimensionner le tableau
    Taille_DdeLR2 = WorksheetFunction.CountIf(Workbooks(NFichier_LR).Sheets("PGM Cl2").Range("A1:A" & S_LR2Derniereligne), "*/" & Dde_Maj)
    Taille_DdeLR5 = WorksheetFunction.CountIf(Workbooks(NFichier_LR).Sheets("PGM Cl5").Range("A1:A" & S_LR5Derniereligne), "*/" & Dde_Maj)

    Taille_Dde = Taille_DdeLR2 + Taille_DdeLR5

    If Taille_Dde > 0 Then
        ' on entre une partie de la feuille PGM 2 dans un tableau
        ReDim S_tableauLR(1 To Taille_Dde, 1 To 4)

        ligne_insertion = 1
        ' on parcours la base LR
        For i = 1 To S_LR2Derniereligne Step 1

            ValeurColonneA = Right(Workbooks(NFichier_LR).Sheets("PGM Cl2").Range("A" & i).Value, 4)

            ' Si la colonne A (au format AAAA) est égal à la demande
            If ValeurColonneA = Dde_Maj Then

                ' On remplit le tableau "fictif" avec les valeurs demandées.
                S_tableauLR(ligne_insertion, 1) = Workbooks(NFichier_LR).Sheets("PGM Cl2").Range("A" & i).Value
                S_tableauLR(ligne_insertion, 2) = Workbooks(NFichier_LR).Sheets("PGM Cl2").Range("B" & i).Value
                S_tableauLR(ligne_insertion, 3) = Workbooks(NFichier_LR).Sheets("PGM Cl2").Range("F" & i).Value
                S_tableauLR(ligne_insertion, 4) = "LR-21"
                ligne_insertion = ligne_insertion + 1
            End If
        Next i

        For j = 1 To S_LR5Derniereligne Step 1

            ValeurColonneA = Right(Workbooks(NFichier_LR).Sheets("PGM Cl5").Range("A" & j).Value, 4)

                ' Si la colonne A (au format AAAA) est égal à la demande
                If ValeurColonneA = Dde_Maj Then

                    ' On remplit le tableau "fictif" avec les valeurs demandées.
                    S_tableauLR(ligne_insertion, 1) = Workbooks(NFichier_LR).Sheets("PGM Cl5").Range("A" & j).Value
                    S_tableauLR(ligne_insertion, 2) = Workbooks(NFichier_LR).Sheets("PGM Cl5").Range("B" & j).Value
                    S_tableauLR(ligne_insertion, 3) = Workbooks(NFichier_LR).Sheets("PGM Cl5").Range("F" & j).Value
                    S_tableauLR(ligne_insertion, 4) = "LR 51"
                    ligne_insertion = ligne_insertion + 1

                End If
        Next j
    End If

'
'
'
'
'Alimentation feuille Top 10 magasin en mode annuel.
' Je pense que c'est là où ça se gâte sérieusement.
'
'
'

    ' On se met sur le classeur des stats (plus précisément sur la feuille "Top 10 Magasin")
    Workbooks(Nfichier_TDB).Sheets("Top 10 Magasin").Activate

    ' On met à zéro notre compteur de Nb
    B_NbLR = 0

    ' Si il n'y a pas de résultat (on peut le savoir avec la taille du tableau créé avec la base de donnée) alors on saute cette étape
    If Taille_Dde > 0 Then

        ' Sinon, pour la ligne 1 au bas du tableau
        For i = 1 To UBound(S_tableauLR)

            'Pour chaque magasin... il manque du code :)

                ' Si les 4 dernier caractères de la colonne date du tableau est égal à la saisie de l'utilisateur
                If Right((S_tableauLR(i, 1)), 4) = Dde_Maj Then

                    ' On ajoute le nombre de corrections de la ligne à un compteur de correction
                    B_NbLR = B_NbLR + S_tableauLR(i, 3)

                    ' On inscrit l'année, le magasin et le nombre dans le fichier résultat
                    Workbooks(Nfichier_TDB).Sheets("Top 10 Magasin").Range("a" & i).Value = Right((S_tableauLR(i, 1)), 4)
                    Workbooks(Nfichier_TDB).Sheets("Top 10 Magasin").Range("b" & i).Value = S_tableauLR(i, 2)
                    Workbooks(Nfichier_TDB).Sheets("Top 10 Magasin").Range("c" & i).Value = B_NbLR

                End If
            'Next S_tableauLR(i, 2)
        Next i
    End If

' Message d'erreur si le fichier est introuvable (nom incorrect ou inexistant)
Else
    MsgBox ("Fichier Base PGM LR introuvable ou ne porte pas le nom Base PGM LR.xlsx. => Ca marche pas quoi. A toi de travailler pour corriger le problème :-)")
End If

Workbooks(NFichier_LR).Close False 'On ferme le fichier LR sans sauvegarde

Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub

Je pense que le tableau est bien alimenté par les deux feuilles.

Je sèche complètement sur le fait de cumuler les Nb (qui répondent au critère donné par l'utilisateur) par magasins pour ensuite les afficher sur la feuille.

C'est pour cela que je demande votre aide et vous remercie d'avance pour le temps consacré.

PS: J'ai essayé de vous mettre le maximum d'éléments, il peut, néanmoins, en manquer....

Bace

56base-pgm-lr0.xlsx (388.13 Ko)
Le 23/05/2020 à 08:01

Personne ne sait comment je pourrais faire pour qu'en parcourant mon tableau (array), je puisse cumuler, pour chaque magasin, le nombre de vente puis réécrire cette liste sur une feuille vierge ?

Le 23/05/2020 à 12:40

Bonjour,

Fusionnes tes 2 feuilles et fait un TCD pour avoir ton TOP10.

Ta macro doit se limiter à fusionner les données et Actualiser le TCD.

Par contre tes dates n'en sont pas, elles sont en texte. Tu ne pourras pas filtrer correctement dessus.

A faire en premier : copier une cellule vide, sélectionner A, collage spécial Ajouter, remettre le format date voulu.

eric

21base-pgm-lr0-1-1.xlsx (480.61 Ko)
Le 23/05/2020 à 13:54

Bonjour bace6, eriiic

bace6 a écrit :

Je boucle dans le tableau pour faire les cumuls, je supprime les doublons éventuel, je classe par ordre décroissant sur le "Nb"

Tu parles de supprimer d'éventuels doublons : il faudrait peut-être commencer par ça et enchaîner par le TCD.

Comment identifies-tu les doublons, sur quelles colonnes t'appuies-tu ?

klin89

Le 24/05/2020 à 08:28

Bonjour,

Merci d'avoir pris le temps de vous pencher sur mon problème.

@Eriiic : Je ne peux pas fusionner les deux feuilles pour la simple et bonne raison qu'à fin 2020, j'aurais très probablement atteint la limite du nombre de ligne autorisé par excel. Sachant qu'il est probable qu'une troisième source soit à ajouter.

@Klin89 : quand je parlais de doublon potentiel: il n'y en a pas dans la base non retouché. Il peut y en avoir quand on lance la macro avec une boucle qui somme. Un magasin apparaitra plusieurs fois et il y aura plusieurs fois la même somme donc suppression des doublons à la fin. Maintenant, il existe peut être une méthode pour dire que ce magasin a déjà été compté ?

En y réfléchissant, je me dis que la solution est peut être de faire une extraction de la "colonne" magasin, de l'écrire sur excel puis de faire une suppression des doublons. Je me retrouve donc avec une liste des magasins existant dans la base.

Enfin, je lance une boucle qui recherche ces magasins et comptabilise le nombre de vente.

Il y a peut être plus optimisé...

Rechercher des sujets similaires à "cumul magasin qui repond critere tableau vba"