Aide pour une macro (base de donnee immense)

Bonjour lisa_marie,

lisa_mariegilbert a écrit :

est-ce que je tamene une autre enigme ???

1 :

lisa_mariegilbert a écrit :

Il faudrait copier coller la ligne B de test de bobine a la fin de la feuille resume

Ce que je propose c'est donc que dans le fichier que je t'ai joint plus haut, tu lances la macro de la feuille Resume et qu'ensuite tu mettes en couleur le résultat que tu veux obtenir (avec quelques explications si possible).

lisa_mariegilbert a écrit :

et actualiser mon tableau croisee dynamique ( qui se trouve sur une nouvelle feuille tableau resultats.

Bon matin !

je te joint le fichier ! j<ai mis en vert et rouge ce que tu n<avais pas compris cest vraiment tres simple en fait. POur les donnes provenant de test bobine on copie collie la ligne 1. pour avoir tous les noms sur la collone 2 et donc aller chercher ces tittres pour le tableau croisee dynamique !

Eyt oui quand je disais la fin c'était tout a droite.

Je me demande quand je rajouterai des équipements est-ce que mon tableau rajoutera la ligne ?

Merci !

Salut,

Change la macro actuelle par celle-ci :

Sub TraiteResume()
    Dim ShtBobine As Worksheet, ShtResume As Worksheet, ShtSommaire As Worksheet
    Dim ModeRecalcul As Long, nbLign&, nbCol&, dercolTestBobine&
    Dim equipement, descript

    ModeRecalcul = Application.Calculation
    Application.Calculation = xlCalculationManual
    Set ShtBobine = Sheets("Test bobine")
    Set ShtResume = Sheets("Resume")
    Set ShtSommaire = Sheets("Sommaire")

    Application.ScreenUpdating = False
    ShtBobine.Range("A:A,E:E,F:F").Copy ShtResume.Columns("A:C")
    nbLign = ShtResume.Range("A" & Rows.Count).End(xlUp).Row - 1
    ShtResume.Columns("D:IV").Delete
    equipement = ShtSommaire.Range("A2:B" & ShtSommaire.Range("A" & Rows.Count).End(xlUp).Row).Value
    nbCol = UBound(equipement, 1)
    ReDim descript(1 To 1, 1 To nbCol)
    For i = 1 To nbCol
        descript(1, i) = equipement(i, 2)
    Next i
    With ShtResume
        .Range("D1").Resize(1, nbCol).Value = Application.Transpose(equipement)
        With .Range("D2").Resize(nbLign, nbCol)
            .FormulaR1C1 = _
            "=VLOOKUP(RC1,INDIRECT(""'""&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(R1C,"":"","" ""),""\"","" ""),""/"","" ""),""?"","" ""),""*"","" ""),""["","" ""),""]"","" "")&""'!$A:$B""),2,FALSE)"
            Application.Calculation = xlCalculationAutomatic
            .Value = .Value
            .Replace "#N/A", "", xlWhole
            .Replace "#REF!", "", xlWhole
        End With
        With ShtBobine
            dercolTestBobine = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column
            If dercolTestBobine > 7 Then
                .Range("B:B").Copy .Columns(dercolTestBobine + 1)
                .Range("H1").Resize(Rows.Count, dercolTestBobine - 8 + 2).Copy _
                ShtResume.Cells(1, 4 + nbCol).Resize(Rows.Count, dercolTestBobine - 8 + 2)
                .Columns(dercolTestBobine + 1).Delete
            End If
        End With
        .Rows(2).Insert
        .Range("A2:C2").Value = .Range("A1:C1").Value
        .Cells(2, 4 + nbCol).Resize(, dercolTestBobine - 8 + 2).Value = .Cells(1, 4 + nbCol).Resize(, dercolTestBobine - 8 + 2).Value
        .Range("D2").Resize(1, nbCol).Value = descript
        .Cells.EntireColumn.AutoFit
    End With
    Application.Calculation = ModeRecalcul
End Sub

Salut !

Sa marche la nouvelle macro.

Avant de parler du graphique jai absolument besoin d'aide ... sa ma passer entre les doigts et je ne me suis apercu de rien avant de compiler les donnes finales.

Dans le premier fichier je met des heures genre 22:00, mais lorsque les equipements sont compile dans leur feuille respectives sa devient 10:00.... alors je me retrouve avec 2 donnes a 10:00 et la sa creer un gros problème !!!!

Parce que ma recherche v ne fonctionne pas correctement et donc je ne peut compiler que les donnees pour 1 demi journee.....

Re,

Effectivement. En fait, apparemment, convertir les données contenant la date et l'heure par la méthode Données/Convertir ne donne pas le même résultat en VBA. En VBA, on se retrouve avec des heures au format "anglo-saxon" de type AM/PM. Exemple : convertir "18/06/2011 22:11" te donnera en VBA une colonne avec "18/06/2011", une colonne avec "10:11" et une autre avec "PM". Voilà d'où vient le 10h...que tu obtiens.

Remplace la macro Repartition par la suivante qui utilise une autre méthode :

Sub Repartition()
    Dim dercol As Long, col&, lim&, i&, k&, nbLignBDD&, derlignPoste&
    Dim poste, a, temp2(), temp As Range
    Dim repertoire As String, nomFichier$, nomFeuil$, FeuilCopie$, tempText1$, tempText2$
    Dim WbkMaitre As Workbook, WbkSommaire As Workbook

    Set WbkMaitre = ThisWorkbook
    repertoire = ThisWorkbook.Path & "\"
    nomFichier = "Fichier exemple - Copie.xlsm"
    Application.ScreenUpdating = False
    Workbooks.Open (repertoire & nomFichier)
    Set WbkSommaire = ActiveWorkbook
    WbkMaitre.Activate
    Sheets("Base de donnée").Copy before:=Sheets(1)
    With ActiveSheet
        FeuilCopie = .Name
        'dernière colonne de la première ligne
        dercol = .Cells(1, Columns.Count).End(xlToLeft).Column
        If dercol = 1 And .[A1] = "" Then Exit Sub
        For col = dercol To 1 Step -3
            Columns(col + 1).Insert xlToRight
            Columns(col + 1).NumberFormat = "hh:mm:ss;@"
        Next col
        'nouvelle dernière colonne de la première ligne
        dercol = .Cells(1, Columns.Count).End(xlToLeft).Column
        If dercol = 1 Then
            ReDim poste(1 To 1, 1 To 1)
            poste(1, 1) = [A1]
        Else
            'met les intitulés des postes dans un tableau
            poste = .[A1].Resize(, dercol)
        End If
        'limite du tableau des intitulés
        lim = UBound(poste, 2)
        tempText2 = " "

        For i = 1 To lim Step 4
            tempText1 = .Cells(1, i)
            'on rajoute un espace dans le nom de la feuille
            nomFeuil = replaceArray(tempText1, tempText2)
            'nb de ligne du poste XX dans la base de données
            nbLignBDD = .Cells(Rows.Count, i).End(xlUp).Row - 1
            Set temp = .Cells(2, i).Resize(nbLignBDD, 1)

            'sépare les dates des heures
            'la méthode par Données / Convertir ne marche pas
            'car les heures sont converties avec AM/PM
            a = temp.Value
            ReDim Preserve a(1 To UBound(a, 1), 1 To 2)
            For k = LBound(a) To UBound(a)
                a(k, 2) = a(k, 1) - Int(a(k, 1)): a(k, 1) = Int(a(k, 1))
            Next k
            temp.Resize(, 2) = a
            Set temp = temp.Resize(, 4)

            'si elle n'existe pas, on l'ajoute
            If Not exist(WbkMaitre, nomFeuil) Then
                Sheets.Add before:=Sheets("Base de donnée")
                ActiveSheet.Name = nomFeuil: [A1] = poste(1, i)
            End If
            With Sheets(nomFeuil)
                .Select
                'dernière ligne de la feuille de chaque poste
                derlignPoste = .Range("A" & Rows.Count).End(xlUp).Row + 1
                'on entre les données de la BDD dans chaque poste
                .Range("A" & derlignPoste).Resize(nbLignBDD, 4).Value = temp.Value
                With .Range("A2:A" & derlignPoste + nbLignBDD - 1)
                    With .Offset(, 4)
                        'création d'une formule permettant de repérer les doublons
                        .FormulaR1C1 = "=RC1&RC2"
                        .NumberFormat = "@"
                        'on enlève les formules, on mets leurs valeurs à la place
                        .Value = .Value
                    End With
                    'suppression des doublons avec la fonction RemoweDuplicates
                    '(menu Données / Supprimer les doublons) d'EXCEL 2007
                    .Resize(, 7).RemoveDuplicates Columns:=5, Header:=xlNo
                    .Offset(, 4).EntireColumn.Delete
                    'on copie le format des cellules
                    temp.Copy
                    .Resize(, 4).PasteSpecial Paste:=xlPasteFormats
                End With
                .[A1].Select
                'ajustement automatique des colonnes
                .Cells.EntireColumn.AutoFit
            End With

        Next i
    End With
    Application.DisplayAlerts = False
    Application.CutCopyMode = False
    Sheets(FeuilCopie).Delete
    With Sheets("Sommaire")
        .Columns(6).ClearContents
        With .Cells(2, 6).Resize(lim)
            .Value = Application.Transpose(poste)
            If lim > 1 Then
                On Error Resume Next
                .SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
                On Error GoTo 0
            End If
        End With
    End With
    Sheets("Base de donnée").Select
End Sub

ouff j'ai eu des sueurs froides j'avais hate que tu me reponde !

jessais sa et je te reviens

Bon matin !

Sa fonctionne mais lorsque je fais resume il me fait qc de bizarre.

Dans le deuxieme fichier

Lors que japplique la fonction resume

IL me rajoute sur la feuille resume en collone D-E-F 3 collone vide et il met comme titre (DATE-(Cellule vide) -NO BOBINE)

Et dans la feuille sommaire il me rajoute également les 3 titres....

Peux-tu joindre le fichier qui te fait ça ?

Rebonjour !

Bon alors j'ai verifier et j ai trouver le probleme pour les collones qui decalaient.

pour les titres de resume il allait chercher les titres dans sommaire et je ne sais pas pourquoi mai il y a avait no de bobine dans le haut de la liste je le retire et sa fonctionne numéro 1

La suite ! Je t'avais demander de mettre la date a la fin dans la feuille resume mais ce n'est pas tres pratique. Est-ce qu'il serait possible de la mettre dans la collone D...

Apres il ne restera que le tableau croisée dynamique... c'est a dire comment faire pour qu'a chaque fois il s'actualise automatique,... et si c'est faisable...

Merci !

Bonjour lisa_marie,

Remplace la macro TraiteResume par celle-ci :

Sub TraiteResume()
    Dim ShtBobine As Worksheet, ShtResume As Worksheet, ShtSommaire As Worksheet
    Dim ModeRecalcul As Long, nbLign&, nbCol&, dercolTestBobine&
    Dim equipement, descript

    ModeRecalcul = Application.Calculation 'met en mémoire le mode de recalcul
    Application.Calculation = xlCalculationManual 'met le calcul en mode manuel
    Set ShtBobine = Sheets("Test bobine")
    Set ShtResume = Sheets("Resume")
    Set ShtSommaire = Sheets("Sommaire")

    Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
    ShtBobine.Range("A:A,E:E,F:F").Copy ShtResume.Columns("A:C") 'copie des colonnes A,E,F de la feuille bobine dans la feuille 'Resume' (A à C)
    nbLign = ShtResume.Range("A" & Rows.Count).End(xlUp).Row - 1 'nb de lignes de la feuille 'Resume'
    ShtResume.Columns("D:IV").Delete 'suppression des colonnes à droite de la colonne C (feuille 'Resume')
    'on met dans une variable 'equipement' les données de la feuille 'Sommaire' (colonnes A et B)
    equipement = ShtSommaire.Range("A2:B" & ShtSommaire.Range("A" & Rows.Count).End(xlUp).Row).Value
    nbCol = UBound(equipement, 1) 'limite sup du tableau 'equipement'
    ReDim descript(1 To 1, 1 To nbCol)
    For i = 1 To nbCol
        descript(1, i) = equipement(i, 2)
    Next i
    With ShtResume
        .Range("D1").Resize(1, nbCol).Value = Application.Transpose(equipement)
        With .Range("D2").Resize(nbLign, nbCol)
            .FormulaR1C1 = _
            "=VLOOKUP(RC1,INDIRECT(""'""&SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(R1C,"":"","" ""),""\"","" ""),""/"","" ""),""?"","" ""),""*"","" ""),""["","" ""),""]"","" "")&""'!$A:$B""),2,FALSE)"
            Application.Calculation = xlCalculationAutomatic
            .Value = .Value
            .Replace "#N/A", "", xlWhole 'on enlève les erreurs #N/A
            .Replace "#REF!", "", xlWhole 'on enlève les erreurs de référence
        End With
        With ShtBobine
            dercolTestBobine = .Cells.Find("*", , , , xlByColumns, xlPrevious).Column 'on trouve la dernière colonne de la feuille bobine
            If dercolTestBobine > 7 Then
                .Range("B:B").Copy .Columns(dercolTestBobine + 1)
                .Range("H1").Resize(Rows.Count, dercolTestBobine - 8 + 2).Copy _
                ShtResume.Cells(1, 4 + nbCol).Resize(Rows.Count, dercolTestBobine - 8 + 2)
                .Columns(dercolTestBobine + 1).Delete
            End If
        End With
        .Rows(2).Insert
        .Range("A2:C2").Value = .Range("A1:C1").Value
        .Cells(2, 4 + nbCol).Resize(, dercolTestBobine - 8 + 2).Value = .Cells(1, 4 + nbCol).Resize(, dercolTestBobine - 8 + 2).Value
        .Range("D2").Resize(1, nbCol).Value = descript
        .Columns(7 + nbCol).Cut 'on coupe la colonne contenant la date
        .Columns("D:D").Insert 'on la remet en colonne D
        .Cells.EntireColumn.AutoFit 'ajustement automatique des colonnes
    End With
    Application.Calculation = ModeRecalcul 'on remet le mode de calcul tel qu'il était au début
End Sub

Edit : Pour le tableau croisé dynamique, je te conseille d'ouvrir un autre post ce sera plus facile à suivre. En plus, tu as plus de chance d'obtenir de l'aide.

Bonjour,

Faute de trouver ou poster ma question je la dépose ici.

J'ai des données journalières sur 59 ans sous excel, donc macro nécessaire ...

sauf que je n'y connait à peut près... rien ^^

mes données se présentent sous la forme :

années 1957

1 Janvier Fevrier etc.......

2

3

31

x ligne entre chaque tableau

années 1958

1 Janvier Fevrier etc.......

2

3

31

Je les voudrais sous la forme:

Date Valeur

01/01/1957

02/01/1957

24/01/2016

Pour pouvoir réaliser une immense et magnifique courbe.

Quelqu'un saurait il me prescrire les ligne de macro nécessaire ?

Merci

Bonjour et bienvenue sur le forum pipoum,

Le mieux aurait été de créer un nouveau post... Mais bon

Peux-tu fournir un fichier exemple ? Ce sera plus simple pour travailler dessus pour nous.

pipoum a écrit :

J'ai des données journalières sur 59 ans sous excel, donc macro nécessaire ...

pas forcément !

Salut ! merci, du coup, j'ai couru plusieurs lièvres et l'un d'entre eux m'as trouvé la solution. Par contre me demandez pas de vous dire comment, même en ayant regardé la macro, c'est du grec pour moi.

Par contre si vous le souhaitez je pourrais vous envoyer le fichier et la macro, pour contribuer un p(etit)eut moi aussi. par contre pas ce soir c'est à mon taf.

Je joint un exemple avec des données bidons, mais je répète ma question à trouvé une réponse.

Il y avait 59 ans de données

La question était d'en faire uniquement 2 colonnes pour faire un graph, une colonne "date" et une "débit" car ce sont des données de débits de rivières.

En tout cas merci encore ! bonne continuation à tous !

Steelson a écrit :

pipoum a écrit :

J'ai des données journalières sur 59 ans sous excel, donc macro nécessaire ...

pas forcément !

Allez pour le fun et pour confirmer les dires de steelson, une solution simple par formule dans le fichier joint.

Le principe :

1. On crée la liste de toutes les dates en ligne (quelques clics)

2. On crée la formule de recherche adéquate et le tour est joué (on tire ensuite la formule)

pipoum a écrit :

ce sont des données de débits de rivières.

Bravo vba-new, cela coule de source !

Haha ! merci cette formule la non plus j'y pige rien mais c'est propre !

Bien joué steelson

Une petite explication pour se coucher moins bête :

=SIERREUR(DECALER(INDIRECT("Feuil1!A"&EQUIV("année "&ANNEE($A2);Feuil1!$A:$A;0));JOUR($A2)+1;MOIS($A2)*2);"pas trouvé")

En gros :

1. On extrait l'année de la date pour chercher la ligne sur laquelle se trouve "année AAAA" :

05/01/1958 --> 1958 --> recherche de la ligne "année 1958" --> disons ligne 58

2. Une fois la ligne de l'année trouvée, on cherche la ligne du jour. Pour ça, on extrait le jour à partir de la date et on décale d'autant de lignes + 1 :

05/01/1958 --> jour 5 --> décalage de 5 + 1 lignes = 6 --> 58 + 6 = 64 --> on sait que la valeur correspondant au 05/01/1958 se trouve à la ligne 64

3. Un fois la ligne de la date trouvée, on cherche la colonne. Pour ça on extrait le mois et on multiplie par 2 pour avoir le décalage :

05/01/1958 --> mois 1 --> décalage de 1 x 2 = 2 colonnes --> colonne A + 2 = colonne C

4. On chope la valeur qui est en C64