XL 2016 Reporting depuis un tableau

loicoss · 9 Janvier 2021

Bonjour,

Je souhaiterai effectué un reporting d'un tableau Excel, exporté depuis un logiciel (mise en forme prédéfinie).

Les données que je souhaite synthétiser, sont :
- identifier chaque client
- pour chaque client faire ressortir les codes associés
- les clients peuvent avoir plusieurs fois le même code, du coup je souhaiterai les compter.

dans les cellules intervenants, il peut y avoir plusieurs clients séparés par des points virgues (

J'ai essayé de répondre à mon besoin avec différentes formules, mais je n'y arrive pas (RECHERCHEV; NB.SI, etc.)

Pourriez-vous m'aider svp sur ce sujet par un jeu de formules ou éventuellement une macro ?

Je vous joins un fichier avec en onglet "Actes" le tableau et en onglet "Reporting" la synthèse que je souhaiterai.

S'il était possible d'avoir cette synthèse avec une mise en forme et le nom des colonnes.

Je vous remercie par avance pour le coup de main.

Bonne journée.

job75 · 9 Février 2021

Bonjour loicoss, le forum,

Vous n'avez pas dû vous fatiguer beaucoup.

J'ai mis les formules matricielles avec le nom T en colonnes J K M, à vous de le faire en colonnes N O P Q.

Et s'il faut en mettre dans d'autres colonnes c'est votre problème.

A+

loicoss · 19 Janvier 2021

Bonjour Job75 et désolé pour le changement du fichier.

Je vous remercie pour votre réponse, votre macro me convient et correspond à mes attentes.
Cependant, il n'y a pas de doublon dans le résultat. C'est une erreur de ma part lors de la recopie des données à la main.
Par conséquent, il manque des UO par intervenant et numéro de bons dans le résultats de votre macro. (j'imagine suite au code permettant la suppression des doublons).

J'ai remis le fichier en pièce jointe.

En vous remerciant par avance.

Loïc.

job75 · 19 Janvier 2021

Bonsoir loicoss, chris, le forum,

J'ai galéré mais je suis arrivé à faire ce que vous voulez.

Voyez ce fichier (3) et la nouvelle macro, pas vraiment simple :

VB:

Sub MAJ()
Dim ncol%, d As Object, w As Worksheet, tablo, i&, x$, s, j%, y$, z$, n&, resu(), k&, col%, ub&
ncol = 6 'nombre de colonnes des résultats
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignoré
'---feuilles Methodes et Actes---
For Each w In Sheets(Array("Methodes", "Actes"))
    tablo = w.[A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        s = Split(tablo(i, 3), ";")
        For j = 0 To UBound(s)
            y = Trim(s(j))
            If y <> "" Then
                z = x & y
                If Not d.exists(z) Then
                    n = n + 1
                    d(z) = n 'mémorise la ligne
                    ReDim Preserve resu(1 To ncol, 1 To n)
                    resu(1, n) = x 'Numéro
                    resu(4, n) = y 'Intervenant
                End If
                k = d(z)
                If w.Name = "Methodes" Then
                    y = Chr(1) & Application.Proper(tablo(i, 4)) & Chr(1) 'encadrement
                    If InStr(resu(5, k), y) = 0 Then resu(5, k) = resu(5, k) & y 'concaténation des Méthodes sans doublon
                Else
                    y = Chr(1) & UCase(tablo(i, 5)) & Chr(1) 'encadrement
                    If InStr(resu(6, k), y) = 0 Then resu(6, k) = resu(6, k) & y 'concaténation des UO sans doublon
                End If
            End If
Next j, i, w
'---feuille Bons---
d.RemoveAll 'RAZ
tablo = Sheets("Bons").[A2].CurrentRegion.Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    x = tablo(i, 1)
    If Not d.exists(x) Then d(x) = i 'mémorise la ligne
Next i
For i = 1 To n
    x = resu(1, i)
    If d.exists(x) Then
        k = d(x)
        If IsDate(tablo(k, 2)) Then resu(2, i) = CDate(tablo(k, 2)) Else resu(2, i) = tablo(k, 2)
        resu(3, i) = tablo(k, 3)
    End If
Next i
If n = 0 Then GoTo 1 'si le tableau est vide
'---déconcaténations et redéfinitions du tableau resu---
For col = 5 To 6
    tablo = resu: Erase resu: n = 0 'RAZ
    For i = 1 To UBound(tablo, 2)
        s = Split(tablo(col, i), Chr(1))
        ub = UBound(s)
        If ub = -1 Then
            n = n + 1
            ReDim Preserve resu(1 To ncol, 1 To n)
            For j = 1 To ncol
                resu(j, n) = tablo(j, i)
            Next j
        Else
            For k = 0 To ub
                If s(k) <> "" Then
                    n = n + 1
                    ReDim Preserve resu(1 To ncol, 1 To n)
                    tablo(col, i) = s(k)
                    For j = 1 To ncol
                        resu(j, n) = tablo(j, i)
                    Next j
                End If
            Next k
        End If
Next i, col
'---transposition---
ReDim tablo(1 To n, 1 To ncol)
For i = 1 To n
    For j = 1 To ncol
        tablo(i, j) = resu(j, i)
Next j, i
'---restitution---
1 With Sheets("Reporting")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A3] '1ère cellule de destination, à adapter
        If n Then
            .Resize(n, ncol) = tablo
            .Resize(n, ncol).Borders.Weight = xlThin 'bordures
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).Delete xlUp 'RAZ en dessous
    End With
    With .UsedRange: End With 'actualise la barre de défilement verticale
End With
End Sub

J'obtiens les résultats de chris plus 4 lignes sans méthodes avec le numéro 00053579610.

A+

loicoss · 20 Janvier 2021

Bonjour Job75,

Le résultat attendu me semble parfait.
Merci beaucoup.

J'ai enfin mon tableau de données comme souhaité.

loicoss · 20 Janvier 2021

Job75 j'aurai besoin d'un petit complément d'information.
Dans mon fichier, j'avais simplifié l'onglet bon car il comporte énormément de colonnes et que les seules utiles sont les 3 que j'avais laissé.
vu que je vais traiter le fichier avec son export brut, pourrais-tu me préciser quelles lignes du code je devrai modifier pour qu'il reprenne les bonnes colonnes.

En te remerciant par avance.

job75 · 20 Janvier 2021

Bonjour loicoss, le forum,

loicoss à dit:
Dans mon fichier, j'avais simplifié l'onglet bon car il comporte énormément de colonnes et que les seules utiles sont les 3 que j'avais laissé.

Il s'agit bien sûr du code sous le commentaire "feuille Bons".

Colonnes de la variable tablo : 1 => Numéro, 2 => Date, 3 => Responsable.

A+

loicoss · 20 Janvier 2021

job75 à dit:
Bonjour loicoss, le forum,

Il s'agit bien sûr du code sous le commentaire "feuille Bons".

Colonnes de la variable tablo : 1 => Numéro, 2 => Date, 3 => Responsable.

A+

Merci pour ce complément d'information.

job75 · 21 Janvier 2021

Bonjour loicoss, le forum,

Dans les déconcaténations la chaîne tablo(col, i) commence et se termine toujours par Chr(1).

Donc dans ce fichier (4) j'ai remplacé :

VB:

'For k = 0 To ub

par :

VB:

For k = 1 To ub - 1

On évite à chaque fois 2 boucles.

A+

loicoss · 21 Janvier 2021

Bonjour job75,

Merci pour ce complément.
le résultat est impeccable.

Bonne journée

loicoss · 3 Février 2021

Bonjour le Forum et bonjour Job75,

je me permets d'ouvrir à nouveau ce sujet.
J'ai bien avancé sur mon projet, cependant afin de faciliter mes requîtes, je souhaiterais séparer le classeur avec la macro et le classeur de données (export actes.xslx)

Du coup je voudrai faire évoluer le code comme ci-dessous

VB:

d.CompareMode = vbTextCompare 'la casse est ignoré
'---feuilles Methodes et Actes---
For Each w In [B]Export actes.xlsx.[/B]Sheets(Array("Methodes", "Actes"))
    tablo = w.[A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
    For i = 2 To UBound(tablo)

merci pour votre aide.

job75 · 3 Février 2021

Bonjour loicoss,

Vous ne dites pas comment vous voulez récupérer le fichier Export actes.xlsx ni où il faut mettre les résultats mais bon téléchargez ces 2 fichiers dans le même dossier.

A+

loicoss · 3 Février 2021

Re bonjour Job75,

Effectivement je n'ai pas fait cette précision.
en gros le fichier de reporting avec la macro se trouvera dans le même dossier que le fichier "Export Actes.xlsx".

Je vais regarder tes fichier.

Merci pour ton aide.

loicoss · 3 Février 2021

Re bonjour Job75,

Alors tes fichiers répondent en partie à ma demande.
Seulement je souhaiterais que le résultat s'affiche sur une feuille (données) dans le fichier "Reporting" et non dans le fichier "Export Actes"

Merci à toi.

job75 · 3 Février 2021

loicoss à dit:
Seulement je souhaiterais que le résultat s'affiche sur une feuille (données) dans le fichier "Reporting" et non dans le fichier "Export Actes".

Les feuilles que l'on veut sont remplies à l'ouverture de ce fichier (2) :

VB:

Private Sub Workbook_Open()
Dim ncol%, d As Object, F As Worksheet, n&, fichier$, w As Worksheet, tablo, i&, x$, s, j%, y$, z$, resu(), k&, col%, ub&
ncol = 6 'nombre de colonnes des résultats
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignoré
Application.ScreenUpdating = False
For Each F In Me.Worksheets 'adapter si nécessaire aux feuilles à traiter
    d.RemoveAll 'RAZ
    n = 0
    fichier = Me.Path & "\" & F.Name & ".xlsx" 'même nom que la feuille
    If Dir(fichier) = "" Then MsgBox "Fichier '" & fichier & "' introuvable !", 48: GoTo 2
    Workbooks.Open fichier 'ouvre le fichier
    '---feuilles Methodes et Actes---
    For Each w In ActiveWorkbook.Sheets(Array("Methodes", "Actes"))
        tablo = w.[A2].CurrentRegion.Resize(, 5) 'matrice, plus rapide
        For i = 2 To UBound(tablo)
            x = tablo(i, 1)
            s = Split(tablo(i, 3), ";")
            For j = 0 To UBound(s)
                y = Trim(s(j))
                If y <> "" Then
                    z = x & y
                    If Not d.exists(z) Then
                        n = n + 1
                        d(z) = n 'mémorise la ligne
                        ReDim Preserve resu(1 To ncol, 1 To n)
                        resu(1, n) = x 'Numéro
                        resu(4, n) = y 'Intervenant
                    End If
                    k = d(z)
                    If w.Name = "Methodes" Then
                        y = Chr(1) & Application.Proper(tablo(i, 4)) & Chr(1) 'encadrement
                        If InStr(resu(5, k), y) = 0 Then resu(5, k) = resu(5, k) & y 'concaténation des Méthodes sans doublon
                    Else
                        y = Chr(1) & UCase(tablo(i, 5)) & Chr(1) 'encadrement
                        If InStr(resu(6, k), y) = 0 Then resu(6, k) = resu(6, k) & y 'concaténation des UO sans doublon
                    End If
                End If
    Next j, i, w
    '---feuille Bons---
    d.RemoveAll 'RAZ
    tablo = ActiveWorkbook.Sheets("Bons").[A2].CurrentRegion.Resize(, 3) 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        x = tablo(i, 1)
        If Not d.exists(x) Then d(x) = i 'mémorise la ligne
    Next i
    For i = 1 To n
        x = resu(1, i)
        If d.exists(x) Then
            k = d(x)
            If IsDate(tablo(k, 2)) Then resu(2, i) = CDate(tablo(k, 2)) Else resu(2, i) = tablo(k, 2)
            resu(3, i) = tablo(k, 3)
        End If
    Next i
    If n = 0 Then GoTo 1 'si le tableau est vide
    '---déconcaténations et redéfinitions du tableau resu---
    For col = 5 To 6
        tablo = resu: Erase resu: n = 0 'RAZ
        For i = 1 To UBound(tablo, 2)
            s = Split(tablo(col, i), Chr(1))
            ub = UBound(s)
            If ub = -1 Then
                n = n + 1
                ReDim Preserve resu(1 To ncol, 1 To n)
                For j = 1 To ncol
                    resu(j, n) = tablo(j, i)
                Next j
            Else
                'For k = 0 To ub
                For k = 1 To ub - 1
                    If s(k) <> "" Then
                        n = n + 1
                        ReDim Preserve resu(1 To ncol, 1 To n)
                        tablo(col, i) = s(k)
                        For j = 1 To ncol
                            resu(j, n) = tablo(j, i)
                        Next j
                    End If
                Next k
            End If
    Next i, col
    '---transposition---
    ReDim tablo(1 To n, 1 To ncol)
    For i = 1 To n
        For j = 1 To ncol
            tablo(i, j) = resu(j, i)
    Next j, i
    '---restitution---
1   ActiveWorkbook.Close False 'ferme le fichier
2   With F
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        With .[A3] '1ère cellule de destination, à adapter
            If n Then
                .Resize(n, ncol) = tablo
                .Resize(n, ncol).Borders.Weight = xlThin 'bordures
            End If
            .Offset(n).Resize(Rows.Count - n - .Row + 1, ncol).Delete xlUp 'RAZ en dessous
        End With
        With .UsedRange: End With 'actualise la barre de défilement verticale
    End With
Next F
End Sub

loicoss · 3 Février 2021

Merci Job75,

Je pense que nous arrivons au bout de mon besoin.

je souhaiterai le même résultat pour un seul fichier "export actes" qui serait reporté dans le fichier reporting avec l'onglet nommé "Données" et que je puisse lancer la macro manuellement et non à l'ouverture du fichier.

job75 · 3 Février 2021

Pour pouvoir exécuter manuellement remplacer Private Sub Workbook_Open() par Sub MAJ().

Et ne mettez qu'une feuille dans le classeur.

XL 2016 Reporting depuis un tableau

XLDnaute Junior

Pièces jointes

XLDnaute Junior

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

Discussions similaires