Heures / jours / équipe de production

Le 24/07/2013 à 15:32

Bonjour à tous,

D'habitude je trouve la solution sur le forum mais là je suis bloquée. ..

voilà mon problème, j'extrais d'un logiciel des données de production en choisissant l'intervalle de date par exemple du 23/07 au 24/07. nous avons une production en 3 x 8 05:00 à 13:00

13:00 à 21:00

21:00 à 5:00

j'ai de cartons déclarés sur une production

Date Production / Quantité/ Motif/ Utilisateur Article

23/07/2013 03:34 / 1000 / personne 1 / carton de produit A

23/07/2013 03:46 / 200 / personne 1 / carton de produit b

23/07/2013 21:50 / 3000 / personne 1 / carton de produit c

23/07/2013 23:46 / 200 / personne 1 / carton de produit b

24/07/2013 03:46 / 1000 / personne 1 / carton de produit a

j'ai fais un tableau avec macro pour les mise en forme et convertir certaines données pour les calculs sur les quantités, puis toujours en macro j'ai inséré un tableau croisé dynamique pour calculer par moyen de filtre par la suite sur les 3 poste de production quelles quantités on été produites pour chaque article.

cela marche sur les équipe en journée mais sur l'équipe de nuit je suis obligée de sélectionner 2 jours le 23 et le 24 et de décocher tous les heures du 23 de 00:00 à 21:00 et toutes celles du 24 de 21:00 à 00:00

je voudrai savoir quelle type de formule je peux insérer dans ma macro pour que le poste de nuit du 23/07 à 21:00 au 24/07 à 05:00 du matin me dise = poste de nuit du 23/07 au 24/07

je ne sais pas si je suis assez clair, si la cellule est comprise entre le 23/07/2013 de 21:00 à 00:00 et du 24/07/2013 de 00:00 à 05:00 alors = poste nuit du 23 au 24

sachant que je fais une extraction des données tous les jours il faut que ma macro marche et que je n'ai pas le besoin de changer la formule à chaque fois

voilà

merci à ceux qui me viendrons en aide

très sincèrement

Sylvie

Le 24/07/2013 à 15:38

Bonjour. Bienvenue sur le Forum

il faut que ma macro marche et que je n'ai pas le besoin de changer la formule à chaque fois

Si c'est une macro, il n'y aura pas de formules, si c'est avec une formule, pas besoin de macro.

Peux-tu joindre un fichier Excel?

Cordialement

Le 24/07/2013 à 17:41

d'abord merci de m'aider

ci-joint le fichier avec l'ongle bilan (c'est les données brutes)

sur l'onglet feuille 1 c'est ma macro

pour gagner du temps (puisque je dois faire l'opération d'extraction tous les jours) j'ai fais une macro (résultat tableau croisé dynamique + lus quelque retouches sur les formats)

le problème c'est l'analyse des données sur des poste en 3 x 8

ci dessous ma macro

Sub bilan_prod()

'

' bilan_prod Macro

'

' Touche de raccourci du clavier: Ctrl+b

'

Columns("C:C").Select

Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

Columns("B:B").Select

Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _

Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _

:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

Columns("C:C").Select

Selection.Delete Shift:=xlToLeft

Columns("B:B").Select

Selection.NumberFormat = "#,##0"

Columns("A:A").Select

Selection.NumberFormat = "m/d/yyyy h:mm"

Columns("A:A").Select

Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _

TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _

Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _

:=Array(1, 4), TrailingMinusNumbers:=True

Selection.ColumnWidth = 12.86

Range("A3").Select

Columns("A:A").EntireColumn.AutoFit

Sheets.Add

ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _

"Bilan_de_production!R1C1:R10031C6", Version:=xlPivotTableVersion10). _

CreatePivotTable TableDestination:="Feuil1!R3C1", TableName:= _

"Tableau croisé dynamique1", DefaultVersion:=xlPivotTableVersion10

Sheets("Feuil1").Select

Cells(3, 1).Select

With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _

"Utilisateur")

.Orientation = xlPageField

.Position = 1

End With

With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _

"Date Production")

.Orientation = xlPageField

.Position = 1

End With

ActiveSheet.PivotTables("Tableau croisé dynamique1").AddDataField ActiveSheet. _

PivotTables("Tableau croisé dynamique1").PivotFields("Quantité"), _

"Nombre de Quantité", xlCount

With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Article" _

)

.Orientation = xlRowField

.Position = 1

End With

With ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields( _

"Nombre de Quantité")

.Caption = "Somme de Quantité"

.Function = xlSum

End With

ActiveSheet.PivotTables("Tableau croisé dynamique1").PivotFields("Article"). _

AutoSort xlAscending, "Article"

End Sub

ps j'ai compressé le fichier (trop gros)

merci encore de ton aide

très sincèrement

Sylvie

51bilan-de-production.zip (71.71 Ko)
Le 25/07/2013 à 01:55

Bonjour,

Un début de réponse avec une fonction personnalisée.

Voir fichier.

A te relire

Option Explicit
Public Function Essai(Cellule As Date)
Dim D As Date, D1 As Date, H As Date
Dim J As Integer

    D = Int(Cellule)
    D1 = D + 1
    J = Day(D)
    H = (Cellule - Int(Cellule)) * 24

    If H > 5 And H <= 13 Then
        Essai = D
        Exit Function
    End If
    If H > 13 And H <= 21 Then
        Essai = D
        Exit Function
    End If
    If H <= 5 Then
        Essai = "nuit du " & J - 1 & " au " & J
    Else
        Essai = "nuit du " & J & " au " & J + 1
    End If

End Function
43bilan-de-production.zip (84.32 Ko)
Le 25/07/2013 à 11:59

bonjour,

J'ai essayer d'incorporer ta formule à la suite de à ma macro mais rien ne marche, désolé pour mon incompétence mais où dois je mettre cette formule (avant ou après dans ma macro)

merci

Le 25/07/2013 à 13:02

Re,

Tu auras certainement constaté que j'ai modifié les valeurs texte de la Colonne A en valeurs numériques

Cdlt

Le 26/07/2013 à 11:06

bonjour

La fonction marche mais juste lorsque je l'inserts dans une macro pour ce classeur ci, et encore il faut que je ferme puis re-ouvre le fichier une fois que j'ai copié ta solution dans ma macro.

inseré dans le dossier des macros (où j'ai toutes mes macros) cela ne marche plus.

je pense que je ne fais pas les choses correctement, depuis hier je tente et retente mais sans résultat.

donc si tu as des conseils je suis preneuse !!

merci de ton aide.

Sylvie

Le 26/07/2013 à 12:36

Bonjour,

Peux-tu envoyer le fichier initial (avant exécution de ta macro, donc sans TCD)?

A te relire

Edit : sinon testes ce code pour la première partie de la macro

Option Explicit
Public Sub bilan_prod()
' Touche de raccourci du clavier: Ctrl+b
'
Dim Ws_source As Worksheet, Ws_résultat As Worksheet
Dim Plage As Range
Dim Derligne As Long, i As Long

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set Ws_source = Worksheets("Bilan_de_production")
    Derligne = Ws_source.Range("A" & Rows.Count).End(xlUp).Row

    With Ws_source
            With .Columns("C:C")
                .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                .TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
                    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
                    :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
                .EntireColumn.AutoFit
                .Delete Shift:=xlToLeft
            End With

            With .Columns("B:B")
                .NumberFormat = "#,##0"
            End With

            With .Columns("A:A")
                .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                    :=Array(1, 4), TrailingMinusNumbers:=True
                .EntireColumn.AutoFit
            End With

            .[G1] = "DateProduction 1"
            For i = 2 To Derligne
                .Cells(i, "G") = Essai(i, 1)
            Next

    End With

    Application.DisplayAlerts = False

End Sub
Le 26/07/2013 à 13:32

Re,

En attendant ton fichier, procédures à copier et à tester...

A te relire 

Option Explicit
Public Ws_source As Worksheet
Public Ws_résultat As Worksheet
Public Plage As Range
Public Derligne As Long
Public i As Long
Public Sub Bilan_production()
' Touche de raccourci du clavier: Ctrl+b
    Traitement_Feuille
    Création_TCD
End Sub
Public Sub Traitement_Feuille()

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set Ws_source = Worksheets("Bilan_de_production")
    Derligne = Ws_source.Range("A" & Rows.Count).End(xlUp).Row

    With Ws_source

            With .Columns("C:C")
                .Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                .TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
                    Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
                    :=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
                .EntireColumn.AutoFit
                .Delete Shift:=xlToLeft
            End With

            With .Columns("B:B")
                .NumberFormat = "#,##0"
            End With

            With .Columns("A:A")
                .TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                    Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
                    :=Array(1, 4), TrailingMinusNumbers:=True
                .EntireColumn.AutoFit
            End With

            .[G1] = "Date Production 1"
            For i = 2 To Derligne
                .Cells(i, "G") = Essai(i, 1)
            Next

    End With

    Set Ws_source = Nothing
    Application.DisplayAlerts = False

End Sub
Public Sub Création_TCD()
Dim PTCache As PivotCache
Dim PT As PivotTable

    With Application
        .DisplayAlerts = False
        .ScreenUpdating = False
    End With

    Set Ws_source = Worksheets("Bilan_de_production")

    On Error Resume Next
        Worksheets("TCD 1").Delete
    On Error GoTo 0

    Set Plage = Range("A1").CurrentRegion

    Set PTCache = ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, _
        SourceData:=Plage)

    Worksheets.Add after:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "TCD"
    Set Ws_résultat = ActiveSheet

    Set PT = PTCache.CreatePivotTable(TableDestination:=Ws_résultat.Range("A1"), _
        TableName:="TCD_1")

    With PT

        With .PivotFields("Utilisateur")
            .Orientation = xlPageField
            .Position = 1
        End With

        With .PivotFields("Date Production 1")
            .Orientation = xlPageField
            .Position = 2
        End With

        .PivotFields("Article").Orientation = xlRowField
        With .PivotFields("Quantité")
            .Orientation = xlDataField
            .Caption = "Qté totale"
            .Function = xlSum
            .NumberFormat = "0.000"
        End With

        .ColumnGrand = True
        .FieldListSortAscending = True
        .ShowDrillIndicators = False

    End With

    Set Ws_source = Nothing: Set Ws_résultat = Nothing: Set Plage = Nothing
    Application.DisplayAlerts = True

End Sub
Le 29/07/2013 à 10:59

bonjour

ci-joint le fichier brut

je test tes macros cet après midi.

merci 1000 fois de me consacrer de ton temps.

sylvie

29bilan-de-production.zip (61.61 Ko)
Le 30/07/2013 à 12:40

Bonjour,

Pas de nouvelles...

Les tests ont-ils été satisfaisants. Dans l'affirmative, penses à clore le sujet.

Cdlt.

Rechercher des sujets similaires à "heures jours equipe production"