Statistiques

grosquick59 · 24 Mai 2011

Bonjour à tous et merci pour votre aide, ce forum est super.
Voilà mon explication :
je cherche à faire des statistiques sur le nombre de procédures par secteurs de l'usine.
Les statistiques doivent être basées sur le numéro de la procédure:

AQ-DO-001
CF-FI-xxx
etc...

le secteur correspond aux 2 premières lettres

Dans les statistiques j'ai plusieurs statuts pour les procédures à savoir :
-DIffusion
-Modification
-annulation
-creation
-reconduction

je souhaite calculer tous les CF-xx-xxx en diffusion, ceux en creation, ceux en modification etc...
Puis je souhaite rajouter deux conditions :
la date de péremption et le fait que le numéro contienne PR ou CR
ex : CF-PR-001, CF-CR-002

En clair je souhaite calculer sous 4 conditions :
Etat (diffusion, modification...)
date peremption
secteur (AC, AQ, CF, CC...)
excepté "contient" -PR- ou -CR-

Un fichier est joint car je pense que ce ne sera pas facilement compréhensible. La liste des catégories est dans le fichier joint.

que ce soit en VBA ou en formule peut importe.
J'étais parti sur des formules mais je suis ouvert à toute suggestion.

Merci d'avance.

grosquick

Hippolite · 25 Mai 2011

Re : Statistiques

Bonjour,
Je pense que le plus simple est d'utiliser la consolidation : menu données / consolider...
+ les macros pour automatiser
Cela nécessite de renommer les cellules A24:A43 avec les bigrammes comme c'est fait avec A52:A71
J'ai fait une macro d'initialisation qui crée les colonnes de données qui seront utilisées pour la consolidation et une macro de consolidation pour chacun des deux tableaux.

VB:

Option Explicit

Public Sub MiseAjour()
    CompleteListe
    Tableau1
    Tableau2
End Sub

Public Sub CompleteListe()
    Dim Dlign As Long, i As Long, PR_CR As String
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With Feuil1
        '-------------Titres-----------------
        .Range("N1") = "Code_1"
        .Range("O1") = "Péremption sans PR ni RC"
        .Range("P1") = "CREATION"
        .Range("Q1") = "DIFFUSION"
        .Range("R1") = "MODIFICATION"
        .Range("S1") = "RECONDUCTION"
        .Range("T1") = "ANNULATION"
        '-------------Données----------------
        Dlign = .Cells(.Rows.Count, 4).End(xlUp).Row    'dernière ligne colonne D
        .Range("N2:T" & Dlign).Clear
        For i = 2 To Dlign
            .Range("N" & i).Value = Left(.Range("D" & i), 2)
            PR_CR = Mid(.Range("D" & i), 4, 2)
            If PR_CR <> "PR" And PR_CR <> "CR" And .Range("N" & i).Value > Date _
               Then .Range("O" & i).Value = .Range("N" & i).Value
            Select Case .Range("I" & i).Value
            Case "CREATION"
                .Range("P" & i).Value = .Range("I" & i).Value
            Case "DIFFUSION"
                .Range("Q" & i).Value = .Range("I" & i).Value
            Case "MODIFICATION"
                .Range("R" & i).Value = .Range("I" & i).Value
            Case "RECONDUCTION"
                .Range("S" & i).Value = .Range("I" & i).Value
            Case "ANNULATION"
                .Range("S" & i).Value = .Range("I" & i).Value
            End Select
        Next i
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub Tableau1()
    Dim Dlign As Long
    Dlign = Feuil1.Cells(Feuil1.Rows.Count, 4).End(xlUp).Row
    Feuil2.Range("B24:F43").ClearContents
    With Feuil2.Range("A23:F43")
        .Consolidate Sources:= _
                     "'Liste_documentation'!R1C14:R" & Dlign & "C20", _
                     Function:=xlCount, TopRow:=True, LeftColumn:=True, _
                     CreateLinks:=False
    End With
End Sub

Sub Tableau2()
    Dim Dlign As Long
    Dlign = Feuil1.Cells(Feuil1.Rows.Count, 4).End(xlUp).Row
    Feuil2.Activate
    Feuil2.Range("B52:D71").ClearContents
    With Feuil2.Range("A51:D71")
        .Consolidate Sources:= _
                     "'Liste_documentation'!R1C15:R" & Dlign & "C20", _
                     Function:=xlCount, TopRow:=True, LeftColumn:=True, _
                     CreateLinks:=False
    End With
End Sub

Pour rendre l'ensemble plus robuste aux changements de mise en page, il serait bon de faire référence aux plages de cellules avec des plages nommées.
A+

grosquick59 · 26 Mai 2011

Re : Statistiques

Bonjour Hippolite,
j'ai eu un peu de mal à comprendre ton code au départ c'est pour ça que j'ai mis du temps à répondre.
Les chiffres renvoyés ne sont pas corrects. J'ai fait quelques modifications dans le fichier et j'ai mis beaucoup plus de numéros pour que ça se rapproche de la réalité.

En tout cas c'est plus pratique d'avoir une Macro plutôt que des formules.
Merci d'avance pour ton aide. (Je cherche aussi de mon côté)

Hippolite · 26 Mai 2011

Re : Statistiques

Re,
J'ai trouvé deux coquilles : sur le test de date et Case "ANNULATION"
+ supprimé les cases vides dans la colonne O

VB:

Public Sub StatsPeremp()
    Dim Dlign As Long, i As Long, PR_CR As String
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With Feuil3
        '-------------Titres-----------------
        .Range("N1") = "Code_1"
        .Range("O1") = "Péremption sans PR ni CR"
        .Range("P1") = "CREATION"
        .Range("Q1") = "DIFFUSION"
        .Range("R1") = "MODIFICATION"
        .Range("S1") = "RECONDUCTION"
        .Range("T1") = "ANNULATION"
        '-------------Données----------------
        Dlign = .Cells(.Rows.Count, 4).End(xlUp).Row    'dernière ligne colonne D
        .Range("N2:T" & Dlign).Clear
        For i = 2 To Dlign
            .Range("N" & i).Value = Left(.Range("D" & i), 2)
            PR_CR = Mid(.Range("D" & i), 4, 2)
            If PR_CR <> "PR" And PR_CR <> "CR" And .Range("K" & i).Value <= Date Then
                .Range("O" & i).Value = .Range("N" & i).Value
            Else
                .Range("O" & i).Value = "-"
            End If
            Select Case .Range("I" & i).Value
            Case "CREATION"
                .Range("P" & i).Value = .Range("I" & i).Value
            Case "DIFFUSION"
                .Range("Q" & i).Value = .Range("I" & i).Value
            Case "MODIFICATION"
                .Range("R" & i).Value = .Range("I" & i).Value
            Case "RECONDUCTION"
                .Range("S" & i).Value = .Range("I" & i).Value
            Case "ANNULATION"
                .Range("T" & i).Value = .Range("I" & i).Value
            End Select
        Next i
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

A+

grosquick59 · 1 Juin 2011

Re : Statistiques

Bonjour,
merci c'est super ça fonctionne !! Tu me sauves la vie.
Est-ce que par hasard tu saurais comment rajouter colonne F le total documentation sauf PR, sauf CR, sauf CREATION, sauf ANNULATION. Cela me permettrai de faire un pourcentage périmé / total.
(je sais j'abuse un peu).

grosquick

Hippolite · 1 Juin 2011

Re : Statistiques

Bonjour,
J'ai opté pour une solution qui met directement les valeurs où il faut.
Pour cela, j'ai deux consolidations qui s'écrasent partiellement dans le deuxième tableau.
Cela peut être pénalisant en durée de traitement pour de très grandes tables de données, dans ce dernier cas il faut mieux ajouter une colonne au premier tableau et la recopier vers le deuxième tableau.

VB:

Option Explicit

Public Sub MiseAjour()
    StatsPeremp
    Tableau1
    Tableau2
    effacer_temporaire
End Sub

Public Sub StatsPeremp()
    Dim Dlign As Long, i As Long, PR_CR As String
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    With Feuil3
        '-------------Titres-----------------
        .Range("N1") = "Code_1"
        .Range("O1") = "Péremption sans PR ni CR"
        .Range("P1") = "total DOCUMENTATION"
        .Range("Q1") = "CREATION"
        .Range("R1") = "DIFFUSION"
        .Range("S1") = "MODIFICATION"
        .Range("T1") = "RECONDUCTION"
        .Range("U1") = "ANNULATION"
        '-------------Données----------------
        Dlign = .Cells(.Rows.Count, 4).End(xlUp).Row    'dernière ligne colonne D
        .Range("N2:T" & Dlign).Clear
        For i = 2 To Dlign
            .Range("N" & i).Value = Left(.Range("D" & i), 2)
            PR_CR = Mid(.Range("D" & i), 4, 2)
            If PR_CR <> "PR" And PR_CR <> "CR" And .Range("K" & i).Value <= Date Then
                .Range("O" & i).Value = .Range("N" & i).Value
            Else
                .Range("O" & i).Value = "-"
            End If

            If PR_CR <> "PR" And PR_CR <> "CR" Then
                Select Case .Range("I" & i).Value
                Case "DIFFUSION", "MODIFICATION", "RECONDUCTION"
                    .Range("P" & i).Value = "OUI"
                Case Else
                    .Range("P" & i).Value = ""
                End Select
            Else
                .Range("P" & i).Value = ""
            End If

            Select Case .Range("I" & i).Value
            Case "CREATION"
                .Range("Q" & i).Value = .Range("I" & i).Value
            Case "DIFFUSION"
                .Range("R" & i).Value = .Range("I" & i).Value
            Case "MODIFICATION"
                .Range("S" & i).Value = .Range("I" & i).Value
            Case "RECONDUCTION"
                .Range("T" & i).Value = .Range("I" & i).Value
            Case "ANNULATION"
                .Range("U" & i).Value = .Range("I" & i).Value
            End Select
        Next i
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Sub Tableau1()
    Dim Dlign As Long
    Dlign = Feuil3.Cells(Feuil1.Rows.Count, 4).End(xlUp).Row
    Feuil1.Range("B24:F43").ClearContents
    With Feuil1.Range("A23:F43")
        .Consolidate Sources:= _
                     "'Liste_documentation'!R1C14:R" & Dlign & "C21", _
                     Function:=xlCount, TopRow:=True, LeftColumn:=True, _
                     CreateLinks:=False
    End With
End Sub

Sub Tableau2()
    Dim Dlign As Long
    Dlign = Feuil3.Cells(Feuil3.Rows.Count, 4).End(xlUp).Row
    Feuil1.Activate

    Feuil1.Range("F52:F71").ClearContents
    With Feuil1.Range("A51:F71")
        .Consolidate Sources:= _
                     "'Liste_documentation'!R1C14:R" & Dlign & "C21", _
                     Function:=xlCount, TopRow:=True, LeftColumn:=True, _
                     CreateLinks:=False
    End With

    Feuil1.Range("B52:D71").ClearContents
    With Feuil1.Range("A51:D71")
        .Consolidate Sources:= _
                     "'Liste_documentation'!R1C15:R" & Dlign & "C21", _
                     Function:=xlCount, TopRow:=True, LeftColumn:=True, _
                     CreateLinks:=False
    End With
End Sub

Sub effacer_temporaire()
    Sheets("Liste_documentation").Range("N:U").ClearContents
End Sub

Sub appel_macro()
    Call StatsPeremp
    Call Tableau1
    Call Tableau2
    Call effacer_temporaire

End Sub

A+

grosquick59 · 2 Juin 2011

Re : Statistiques

Merci beaucoup pour ton aide.

Statistiques

grosquick59

Guest

Pièces jointes

Hippolite

XLDnaute Accro

grosquick59

Guest

Pièces jointes

Hippolite

XLDnaute Accro

grosquick59

Guest

Hippolite

XLDnaute Accro

grosquick59

Guest

Discussions similaires

Statistiques

grosquick59

Guest

Pièces jointes

Hippolite

XLDnaute Accro

grosquick59

Guest

Pièces jointes

Hippolite

XLDnaute Accro

grosquick59

Guest

Hippolite

XLDnaute Accro

grosquick59

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency