XL 2016 Reporting depuis un tableau

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

job75

XLDnaute Barbatruc
Bonsoir loicoss, chris,

Une solution VBA, voyez le fichier joint et cette macro dans le code de la feuille "Reporting" :
VB:
Private Sub Worksheet_Activate()
Dim d As Object, dest As Range, tablo, i&, s, x$, j%, y$, z$, a, b
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
Set dest = [B3] '1ère cellule du tableau des résultats
Application.ScreenUpdating = False
If FilterMode Then ShowAllData 'si la feuille est filtrée
dest(2).Resize(Rows.Count - dest.Row, 3).Delete xlUp 'RAZ
'---1er traitement---
tablo = Feuil1.[A2].CurrentRegion.Columns(3).Resize(, 3) 'matrice, plus rapide
For i = 2 To UBound(tablo)
    s = Split(tablo(i, 1), ";")
    x = tablo(i, 3)
    For j = 0 To UBound(s)
        y = Trim(s(j))
        If y <> "" Then
            z = x & Chr(1) & y
            d(z) = d(z) + 1 'comptage
        End If
Next j, i
If d.Count = 0 Then GoTo 1
a = d.keys: b = d.items
'---1ère restitution---
ReDim tablo(UBound(a), 2) 'base 0
For i = 0 To UBound(a)
    s = Split(a(i), Chr(1))
    tablo(i, 0) = s(1)
    tablo(i, 1) = s(0)
    tablo(i, 2) = b(i)
Next i
dest(2).Resize(i, 3) = tablo
dest(2).Resize(i, 3).Sort dest, xlAscending, dest(1, 2), , xlAscending, Header:=xlNo 'tri sur 2 colonnes
'---2ème traitement pour effacer les doublons---
a = dest.Resize(i + 1) 'matrice, plus rapide
tablo = a
For i = 2 To UBound(a)
    If LCase(a(i, 1)) = LCase(a(i - 1, 1)) Then tablo(i, 1) = ""
Next i
'---2ème restitution---
dest.Resize(i - 1) = tablo
'---bordures---
dest(1, 2).Resize(i - 1, 2).Borders.Weight = xlThin
dest.Resize(i - 1).BorderAround Weight:=xlThin 'pourtour
With dest.Resize(i - 1).SpecialCells(xlCellTypeConstants)
    .Borders(xlEdgeTop).Weight = xlThin
    .Borders(xlInsideHorizontal).Weight = xlThin
End With
1 With UsedRange: End With 'actualise la barre de défilement verticale
End Sub
Elle se déclenche quand on active la feuille.

Elle est très rapide car elle utilise des tableaux VBA et le Dictionary.

Nota : j'ai testé l'application des bordures avec SpecialCells.

Pas de problème sur 100 000 lignes mais sur 1 000 000 lignes ça prend beaucoup de temps.

A+
 

Pièces jointes

  • Export actes par client(1).xlsm
    24.6 KB · Affichages: 9
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour loicoss,

Dans ce fichier (2) la macro est affectée à un bouton.

Et les bordures sont appliquées par 2 MFC, sauf le pourtour qui reste appliqué par la macro.

Cela évite tout problème s'il y a 1 000 000 de lignes :cool:

A+
 

Pièces jointes

  • Export actes par client(2).xlsm
    24.7 KB · Affichages: 9

loicoss

XLDnaute Junior
Bonjour à tous,



J'ouvre à nouveau ce sujet car cette première étape ne répond pas totalement à mon besoin.


En fait, l'extraction brute de mon fichier me donne 3 onglets différents que je souhaite combiner.


Le résultat attendu se trouve dans l'onglet "Reporting".


Sachant que la difficulté est que dans 2 des onglets les intervenants apparaissent l'un pour son résultat de méthode et l'autre pour l'UO.


à noter également que le point commun de ces trois onglet est le numéro.


J'ai essayé en dehors des macros de faire cette synthèse avec Power Query mais je ne m'en sors pas.

Mon besoin final est pour chaque intervenant d'avoir pour un même numéro, la date, le responsable, la méthode et le nombre d'UO


En vous remerciant pour votre précieuse aide.
 

Pièces jointes

  • Export actes.xlsx
    12.3 KB · Affichages: 6

job75

XLDnaute Barbatruc
Bonsoir loicoss, chris,

Voyez le fichier joint et la macro du bouton :
VB:
Sub MAJ()
Dim ncol%, d As Object, tablo, i&, x$, s, j%, y$, z$, n&, resu(), lig&
ncol = 8 'nombre de colonnes des résultats
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignoré
'---feuille Methodes---
tablo = Sheets("Methodes").[A2].CurrentRegion.Resize(, 4) '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
                y = LCase(tablo(i, 4))
                resu(IIf(y = "air", 5, IIf(y = "sol", 7, 6)), n) = y 'Méthode
            End If
        End If
Next j, i
'---feuille Actes---
tablo = Sheets("Actes").[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
            resu(8, d(z)) = tablo(i, 5) 'UO
        End If
Next j, i
'---feuilles 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
        lig = d(x)
        If IsDate(tablo(lig, 2)) Then resu(2, i) = CDate(tablo(lig, 2)) Else resu(2, i) = tablo(lig, 2)
        resu(3, i) = tablo(lig, 3)
    End If
Next i
'---transposition---
If n Then
    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
End If
'---restitution---
With Sheets("Reporting")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A4]
        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
A+
 

Pièces jointes

  • Export actes(1).xlsm
    26.2 KB · Affichages: 4

loicoss

XLDnaute Junior
Bonsoir Chris et Bonsoir Job75

Voici ma pièce jointe modifiée avec mon souhait de résultat par rapport aux différents onglets.
J'ai pris 3 exemples (3 couleurs différentes).

Merci à vous.
 

Pièces jointes

  • Export actes.xlsx
    13.5 KB · Affichages: 4

job75

XLDnaute Barbatruc
Si vous passez votre temps à modifier votre fichier on ne va pas s'en sortir.

Fichier (2) avec la nouvelle macro :
VB:
Sub MAJ()
Dim ncol%, d As Object, tablo, i&, x$, s, j%, y$, z$, n&, resu(), lig&
ncol = 6 'nombre de colonnes des résultats
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignoré
'---feuille Methodes---
tablo = Sheets("Methodes").[A2].CurrentRegion.Resize(, 4) '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
                resu(5, n) = Application.Proper(tablo(i, 4)) 'Méthode
            End If
        End If
Next j, i
'---feuille Actes---
tablo = Sheets("Actes").[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
            resu(6, d(z)) = tablo(i, 5) 'UO
        End If
Next j, i
'---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
        lig = d(x)
        If IsDate(tablo(lig, 2)) Then resu(2, i) = CDate(tablo(lig, 2)) Else resu(2, i) = tablo(lig, 2)
        resu(3, i) = tablo(lig, 3)
    End If
Next i
'---transposition---
If n Then
    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
End If
'---restitution---
With Sheets("Reporting")
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[A3]
        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
Nota : dans la feuilles "Actes" lignes 3 et 4 il y a doublons, la macro retient uniquement le 2ème UO.
 

Pièces jointes

  • Export actes(2).xlsm
    27.5 KB · Affichages: 7

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 885
Membres
101 830
dernier inscrit
sonia poulaert