Extraction d'un tableau croisé dynamique

Le 15/05/2023 à 16:01

Bonjour, je bloque un peu, est ce que c'est possible que qqn me donne un coup de main ?

J’ai 2 tableaux croisé dynamique (Le premier : rendement en fonction de la machine et de la date

image

Le deuxième les pannes en fonction de la machine et du type de panne par date (DB2/DB419 sont les machines et 2/3/52… les différents type de panne.

image

Je voudrais les fusionner. Ne pouvant pas fusionner avec power QUERY. J’ai décidé de faire une extraction des 2 tableaux puis refaire un tableau croisé dynamique à partir de celui-là. En abscisse la date, en ordonnée les différents types de défauts et le rendement par machine.

image

En noir le rendement.

Je récupère les infos dans ce tableau avec la formule =LIREDONNEESTABCROISDYNAMIQUE("KTPPAS";TCD_Panne!$A$3;"DateJ";$A5;"KMACHI2";$A$2;"KNUINC";B$4)

image

La colonne 1 des dates est automatique et le nombre de type de défaut aussi. En gros on cherche la cellule A2 (le nom de la machine) dans le tableau croisé dynamique dans la première colonne et on extrait toute les dates en dessous jusqu’à la prochaine machine. Puis ont remplis les infos

Mais mes macros ne fonctionne pas correctement. Je n'arrive pas à déposer le fichier ( trop lourd même compressé). Module 6 ne fonctionne pas

Module 1: 

Sub ExecuterModules()
    ' Efface les traits et le fond coloré de la feuille
    Sheets("Feuil3").Cells.ClearFormats

    ' Exécute les modules
    Application.Run "Module2.ExtrairePremiereColonneTCD"
    Application.Run "Module3.ExtraireLigneTCDPanne"
    Application.Run "Module4.ExtraireLigneTCDRendement"

    ' Ajuste la taille des colonnes automatiquement
    Sheets("Feuil3").Columns.AutoFit
End Sub
Module 2: 
Sub ExtrairePremiereColonneTCD()
    Dim wsPanne As Worksheet
    Dim ptPanne As PivotTable
    Dim rngSourcePanne As Range
    Dim rngDestination As Range
    Dim lastRow As Long
    Dim destinationRow As Long
    Dim valeurRecherche As Variant
    Dim valeurTrouvee As Boolean

    ' Spécifiez la feuille contenant le TCD "TCD_Panne1"
    Set wsPanne = ThisWorkbook.Sheets("TCD_Panne")

    ' Spécifiez le nom du TCD "TCD_Panne1"
    Set ptPanne = wsPanne.PivotTables("TCD_Panne1")

    ' Spécifiez la plage source contenant les données du TCD "TCD_Panne1" à partir de la ligne 5
    Set rngSourcePanne = ptPanne.TableRange2.Columns(1).Offset(5)

    ' Spécifiez la feuille de destination "Feuil1" et la première cellule A5
    Set rngDestination = ThisWorkbook.Sheets("Feuil3").Range("A5")

    ' Récupérer la valeur de recherche de la cellule A2 dans la feuille "Feuil1"
    valeurRecherche = ThisWorkbook.Sheets("Feuil3").Range("A2").Value

    ' Trouver la dernière ligne dans la plage source
    lastRow = rngSourcePanne.Cells(rngSourcePanne.Rows.Count, 1).End(xlUp).Row

    ' Initialiser la ligne de destination
    destinationRow = rngDestination.Row

    ' Vérifier si la valeur recherchée est présente dans la plage source
    valeurTrouvee = False
    For i = 1 To lastRow
        If rngSourcePanne.Cells(i, 1).Value = valeurRecherche Then
            valeurTrouvee = True
            Exit For
        End If
    Next i

    ' Si la valeur recherchée est trouvée, extraire les valeurs à partir de la ligne correspondante
    If valeurTrouvee Then
        ' Parcourir les valeurs dans la plage source à partir de la ligne de la valeur trouvée
        For j = i + 1 To lastRow
            ' Vérifier si la valeur est une date
            If Not IsDate(rngSourcePanne.Cells(j, 1).Value) Then
                Exit For
            End If
            ' Copier la valeur dans la cellule de destination
            rngDestination.Offset(destinationRow - rngDestination.Row, 0).Value = rngSourcePanne.Cells(j, 1).Value
            ' Passer à la prochaine ligne de destination
            destinationRow = destinationRow + 1
        Next j
    End If

    ' Si la valeur recherchée n'est pas trouvée, afficher un message
    If Not valeurTrouvee Then
        MsgBox "La valeur recherchée n'a pas été trouvée.", vbInformation
    End If

    ' Ajuster la mise en forme si nécessaire
    With rngDestination.CurrentRegion
        .EntireColumn.AutoFit
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
    End With
End Sub
Module 3

Sub ExtraireLigneTCDPanne()
    Dim wsSource As Worksheet
    Dim ptSource As PivotTable
    Dim rngSource As Range
    Dim rngDestination As Range

    ' Spécifiez la feuille contenant le TCD
    Set wsSource = ThisWorkbook.Sheets("TCD_Panne")

    ' Spécifiez le nom du TCD
    Set ptSource = wsSource.PivotTables("TCD_Panne1")

    ' Spécifiez la plage source contenant toute la ligne du TCD en excluant la première colonne
    Set rngSource = ptSource.TableRange2.Rows(4).Offset(, 1).Resize(1, ptSource.TableRange2.Columns.Count - 1)

    ' Spécifiez la feuille de destination et la plage de destination où les données seront collées
    Set rngDestination = ThisWorkbook.Sheets("Feuil3").Range("B4")

    ' Effacez uniquement les valeurs précédentes dans la plage de destination correspondant aux données extraites
    rngDestination.Resize(1, rngSource.Columns.Count).ClearContents

    ' Copiez les données de toute la ligne du TCD dans la plage de destination
    rngSource.Copy Destination:=rngDestination

    ' Ajustez la mise en forme si nécessaire
    With rngDestination.CurrentRegion
        .EntireRow.AutoFit
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
    End With
End Sub
Module 4: 
Sub ExtraireLigneTCDRendement()
    Dim wsSource As Worksheet
    Dim ptSource As PivotTable
    Dim rngSource As Range
    Dim rngDestination As Range

    ' Spécifiez la feuille contenant le TCD
    Set wsSource = ThisWorkbook.Sheets("TCD_Rendement")

    ' Spécifiez le nom du TCD
    Set ptSource = wsSource.PivotTables("TCD_Rendement1")

    ' Spécifiez la plage source contenant toute la ligne du TCD en excluant la première colonne
    Set rngSource = ptSource.TableRange2.Rows(3).Offset(, 1).Resize(1, ptSource.TableRange2.Columns.Count - 1)

    ' Spécifiez la feuille de destination
    Dim wsDestination As Worksheet
    Set wsDestination = ThisWorkbook.Sheets("Feuil3")

    ' Rechercher la dernière cellule non vide contenant des chiffres dans la ligne 4 de la feuille de destination
    Dim lastCol As Long
    Dim i As Long
    lastCol = wsDestination.Cells(4, wsDestination.Columns.Count).End(xlToLeft).Column

    For i = lastCol To 1 Step -1
        If IsNumeric(wsDestination.Cells(4, i).Value) Then
            Set rngDestination = wsDestination.Cells(4, i + 1)
            Exit For
        End If
    Next i

    ' Si aucune cellule non vide contenant des chiffres n'a été trouvée, commencer à partir de la colonne B
    If rngDestination Is Nothing Then
        Set rngDestination = wsDestination.Cells(4, 2)
    End If

    ' Effacez uniquement les valeurs précédentes dans la plage de destination
    rngDestination.Resize(1, rngSource.Columns.Count).ClearContents

    ' Assigner les valeurs de la ligne du TCD à la plage de destination
    rngDestination.Resize(1, rngSource.Columns.Count).Value = rngSource.Value

    ' Ajustez la mise en forme si nécessaire
    With rngDestination.CurrentRegion
        .EntireRow.AutoFit
        .Borders.LineStyle = xlContinuous
        .Borders.Weight = xlThin
    End With
End Sub

Module 6:

Sub InsererFormule()

Dim ws As Worksheet

Dim formula As String

On Error GoTo ErrorHandler

' Spécifier la feuille de destination

Set ws = ThisWorkbook.Sheets("Feuil3")

' Formule à insérer dans la cellule B5

formula = "=LIREDONNEESTABCROISDYNAMIQUE(""KTPPAS"", ""TCD_Panne""!$A$3, ""Date J"", $A5, ""KMACHI2"", $A$2, ""KNUINC"", B$4)"

' Insérer la formule dans la cellule B5

ws.Range("B5").FormulaLocal = formula

' Ajuster la mise en forme si nécessaire

With ws.Range("B5")

.EntireColumn.AutoFit

.Borders.LineStyle = xlContinuous

.Borders.Weight = xlThin

End With

Exit Sub

ErrorHandler:

MsgBox "Erreur : " & Err.Number & " - " & Err.Description, vbExclamation

End Sub

Le 15/05/2023 à 17:22

Bonjour

Tu ne réponds pas aux messages https://forum.excel-pratique.com/excel/tableau-croise-dynamique-et-graphique-183933

Le 15/05/2023 à 18:47

Désolé j’avais pas vue votre message.

j’ai re-expliqué dans ce poste.

Est-ce + compréhensible dans mes attentes ?
comme vous l’aviez dit on ne peut pas fusionner les champs, il n’y a pas de clé commun. J’ai longtemps cherché.

Le 15/05/2023 à 20:05

RE

La question soulevée dans l'autre post reste entière : tu as des mailles d'analyse différentes, des dates différentes...

Bref sans vraiment mettre à plat les données dont tu disposes (les titres sont souvent abscons) et ce que tu veux faire on n'avancera pas...

Le 16/05/2023 à 12:13

MACHINE 1

Rendement en %

Panne type 1 en %

Date

56

5

01/05787
02/056823
03/05752
04/054
05/057313
06/05

66

18

Bonjour,

La ou je n'ai pas de date commun je ne prend pas l'info, je ne vois pas le problème avec les dates. Il y a un filtre avec les dates; On a des courbes et un diagramme en bâton si les dates ne sont pas commun, ça fera un trou dans le graphique mais ça c'est pas grave.

Concernant les titres qui sont difficile à comprendre

image
Rechercher des sujets similaires à "extraction tableau croise dynamique"