XL 2016 Reporting depuis un tableau

L

loicoss

XLDnaute Junior
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.
 

Pièces jointes

  • Export actes par client.xlsx
    12.7 KB · Affichages: 28
Solution
job75
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+
Trier par date Trier par votes
L

loicoss

XLDnaute Junior
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.
 

Pièces jointes

  • 5 - Export actes par client(4).xlsm
    27.4 KB · Affichages: 2
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Export actes(3).xlsm
    30.7 KB · Affichages: 9
Vote positif 0 Vote négatif
L

loicoss

XLDnaute Junior
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.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Export actes(4).xlsm
    28.7 KB · Affichages: 7
Vote positif 0 Vote négatif
L

loicoss

XLDnaute Junior
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.
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • Reporting(1).xlsm
    22.9 KB · Affichages: 6
  • Export actes.xlsx
    14.6 KB · Affichages: 4
Vote positif 0 Vote négatif
L

loicoss

XLDnaute Junior
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.
 
Dernière édition:
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
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".
Cliquez pour agrandir...
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
 

Pièces jointes

  • Reporting(2).xlsm
    25.1 KB · Affichages: 3
  • Export actes 1.xlsx
    12.6 KB · Affichages: 3
  • Export actes 2.xlsx
    12.6 KB · Affichages: 2
  • Export actes 3.xlsx
    12.6 KB · Affichages: 2
Vote positif 0 Vote négatif
L

loicoss

XLDnaute Junior
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.
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Question
Microsoft 365 Modifier un tableau pour reporting
Réponses
5
Affichages
161
alexga78
A
L
  • Question
XL 2016 Création d'une étiquette CB avec Excel
Réponses
5
Affichages
198
lincoln75
L
M
  • Question
XL 2016 VBA au lieu de MEC
Réponses
4
Affichages
221
marc94600
M
F
  • Question
XL 2016 Générer un rapport pdf depuis excel
Réponses
10
Affichages
609
fraux
F
A
  • Résolu(e)
XL 2019 Copier/coller un tableau
Réponses
6
Affichages
412
Audrey V
A
J
  • Question
XL 2016 Tableau de bord - report de données
2
Réponses
16
Affichages
405
chris
chris
Q
  • Question
Microsoft 365 Créer un formulaire pour duplication d'onglet avec tableau
Réponses
6
Affichages
193
job75
job75
S
  • Question
XL 2019 Regroupement données dans un tableau
2
Réponses
18
Affichages
549
Shimano
S
S
  • Résolu(e)
Microsoft 365 Excel recopier des données d'un tableau dans un autre onglet sans macro
Réponses
5
Affichages
521
Sissou71
S
L
  • Résolu(e)
Microsoft 365 VBA - Attribuer mise en forme en fonction de valeur cellule d'une liste
Réponses
14
Affichages
297
Laliepomm
L

Membres actuellement en ligne

18 membres et 378 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 157
Messages
2 085 819
Membres
102 992
dernier inscrit
KOSTIC