XL 2013 VBA synthèse base de données sans doublons

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion Honor
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
H

Honor

XLDnaute Nouveau
Bonjour,

J'ai une feuille "data" où :
- on peut avoir plusieurs fois le même identifiant pour un type différent (A1 à A..)
- une quantité est associé à chaque identifiant pour un type donné
- un libellé désigne un même identifiant

Je souhaite sur ma feuille synthèse :
- avoir en colonne A mes identifiants dans l'ordre croissant sans doublons
- avoir en colonne B le libellé correspondant à l'identifiant
- avoir en ligne 1 de la colonne C à la colonne ... suivant le nombre de type existant (variable)
- ensuite je calcule le total en fonction des 2 critères (type et identifiant)
- en dernière ligne je cherche le total de chacune des colonnes.
J'ai un pb au niveau de l'apparition de ma ligne 1, les types se collent en colonne et non en ligne..

Merci d'avance si vous avez des idées 🙂
 

Pièces jointes

Trier par date Trier par votes
Re : VBA synthèse base de données sans doublons

Bonsoir Honor, R@chid le forum, 🙂

A tester :
VB: 
Option Explicit

Sub test()
Dim x, a, b(), i As Long, j As Long, n As Long, temp, txt As String
    With Sheets("data").Cells(1).CurrentRegion
        a = .Value
        x = Filter(.Parent.Evaluate("transpose(if(countif(offset(" & .Columns(3).Address & _
                 ",,,row(1:" & .Rows.Count & "))," & .Columns(3).Address & ")=1, " & _
                  .Columns(3).Address & ",char(2)))"), Chr(2), 0)
        ReDim b(1 To .Rows.Count, 1 To UBound(x) + 2)
        b(1, 1) = "Identifiant": b(1, 2) = "Libellé"
        For i = 1 To UBound(x)
            b(1, i + 2) = x(i)
        Next
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                If Not .exists(txt) Then
                    .Item(txt) = .Count + 2
                    For j = 1 To 2
                        b(.Item(txt), j) = a(i, j)
                    Next
                End If
                temp = Application.Match(a(i, 3), x, 0)
                b(.Item(txt), temp + 1) = b(.Item(txt), temp + 1) + a(i, 4)
            Next
            n = .Count + 1
        End With
    End With
    Application.ScreenUpdating = False
    'Restitution
    With Sheets("synthèse").Cells(1)
        .CurrentRegion.Clear
        .Resize(n, UBound(b, 2)).Value = b
        With .CurrentRegion
            With .Offset(.Rows.Count, 2).Resize(1, .Columns.Count - 2)
                .Formula = "=sum(r2c:r[-1]c)"
            End With
            .Offset(.Rows.Count).Cells(1).Value = "Total"
        End With
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .Interior.ColorIndex = 44
                .BorderAround Weight:=xlThin
            End With
            With .Rows(.Rows.Count)
                .Interior.ColorIndex = 19
                .BorderAround Weight:=xlThin
            End With
            .Columns("a:b").ColumnWidth = Array(12, 9)
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub
klin89
 
Vote positif 0 Vote négatif
Re : VBA synthèse base de données sans doublons

Bonjour,

Voir PJ

http://boisgontierjacques.free.fr/fichiers/Cellules/Stat2D2.xls

Les dictionnaires permettent d'indexer les lignes et colonnes du tableau Tstat() et ainsi d'accélérer la recherche .

Code: 
Sub Stat2D()
  Set f1 = Sheets("data")
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  Set d3 = CreateObject("Scripting.Dictionary")
  Tbl = f1.Range("a2:d" & f1.[A65000].End(xlUp).Row)
  For i = 1 To UBound(Tbl): d1(Tbl(i, 1)) = "": d2(Tbl(i, 3)) = "": Next
  Dim TStat(): ReDim TStat(1 To d1.Count, 1 To d2.Count)
  Dim Tcol: ReDim Tcol(1 To d2.Count): Dim Tlig: ReDim Tlig(1 To d1.Count)
  lig = 1: col = 1
  Mlig = lig:  Mcol = col
  d1.RemoveAll: d2.RemoveAll
  For i = 1 To UBound(Tbl)
    If d1.exists(Tbl(i, 1)) Then lig = d1(Tbl(i, 1)) Else d3(Tbl(i, 2)) = "": d1(Tbl(i, 1)) = Mlig: lig = Mlig: Mlig = Mlig + 1
    If d2.exists(Tbl(i, 3)) Then col = d2(Tbl(i, 3)) Else d2(Tbl(i, 3)) = Mcol: col = Mcol: Mcol = Mcol + 1
      TStat(lig, col) = TStat(lig, col) + Tbl(i, 4)
      Tlig(lig) = Tlig(lig) + Tbl(i, 4)
      Tcol(col) = Tcol(col) + Tbl(i, 4)
    Next i
    Set f2 = Sheets("synthèse")
    f2.[a2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
    f2.[b2].Resize(d3.Count, 1) = Application.Transpose(d3.keys)
    f2.[c1].Resize(1, d2.Count) = d2.keys
    f2.[c2].Resize(d1.Count, d2.Count) = TStat
    f2.[c2].Offset(d1.Count).Resize(, d2.Count) = Tcol
    f2.[c2].Offset(, d2.Count).Resize(d1.Count) = Application.Transpose(Tlig)
    '-- tri
    [a2].Resize(d1.Count, d2.Count + 3).Sort key1:=[a2], Header:=xlNo
    '-- présentation
    'f2.[c2].Resize(d1.Count, d2.Count).SpecialCells(4) = 0
    f2.[a2].Resize(d1.Count, 1).BorderAround Weight:=xlThin
    f2.[b2].Resize(d3.Count, 1).BorderAround Weight:=xlThin
    f2.[c1].Resize(1, d2.Count + 1).BorderAround Weight:=xlThin
    f2.[c2].Resize(d1.Count, d2.Count).BorderAround Weight:=xlThin
    f2.[a2].Offset(d1.Count).Resize(, d2.Count + 3).BorderAround Weight:=xlThin
    f2.[c1].Offset(, d2.Count).Resize(d1.Count + 2).BorderAround Weight:=xlThin
    For k = 1 To d2.Count: f2.[c1].Offset(, k - 1).Resize(d1.Count + 2).BorderAround Weight:=xlThin: Next
End Sub

JB
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : VBA synthèse base de données sans doublons

merci pour toutes vos réponses, c'est super!
Je viens de me mettre à VBA..je ne comprends pas toutes les lignes notamment avec l'utilisation du Ubound et des tableaux à redimensionner..je suis sur les tutos d'explications 😉

D'autre part, est ce que vous avez des pistes pour remplacer les cellules vides par des 0 ? même si je ne souhaite pas l'affichage des mes colonnes ou lignes vides..

Merci encore!
 
Vote positif 0 Vote négatif
Re : VBA synthèse base de données sans doublons

JB est ce que tu pourrais juste me donner quelques indications pour mieux comprendre comment tu as obtenu le code.. surtout sur le début du code par rapport au dimensionnement des tableaux, utilisation de ubound et des différents dicctionnaires..merci d'avance 🙂
 
Vote positif 0 Vote négatif
Re : VBA synthèse base de données sans doublons

Re Honor,
Bonjour JB,

VB: 
Option Explicit

Sub test()
Dim x, a, b(), i As Long, j As Long, n As Long, temp, txt As String
    With Sheets("data").Cells(1).CurrentRegion
        a = .Value
        x = Filter(.Parent.Evaluate("transpose(if(countif(offset(" & .Columns(3).Address & _
            ",,,row(1:" & .Rows.Count & "))," & .Columns(3).Address & ")=1, " & _
            .Columns(3).Address & ",char(2)))"), Chr(2), 0)
        ReDim b(1 To .Rows.Count, 1 To UBound(x) + 2)
        b(1, 1) = "Identifiant": b(1, 2) = "Libellé"
        For i = 1 To UBound(x)
            b(1, i + 2) = x(i)
        Next
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                txt = Join(Array(a(i, 1), a(i, 2)), Chr(2))
                If Not .exists(txt) Then
                    .Item(txt) = .Count + 2
                    For j = 1 To 2
                        b(.Item(txt), j) = a(i, j)
                    Next
                End If
                temp = Application.Match(a(i, 3), x, 0)
                b(.Item(txt), temp + 1) = b(.Item(txt), temp + 1) + a(i, 4)
            Next
            n = .Count + 1
        End With
    End With
    Application.ScreenUpdating = False
    'Restitution
    With Sheets("synthèse").Cells(1)
        .CurrentRegion.Clear
        .Resize(n, UBound(b, 2)).Value = b
        With .CurrentRegion
            On Error Resume Next
            .SpecialCells(4) = 0
            On Error GoTo 0
            .Cells(1).Resize(.Rows.Count, .Columns.Count).Sort key1:=.Cells(1), Header:=xlYes
            With .Offset(.Rows.Count, 2).Resize(1, .Columns.Count - 2)
                .Formula = "=sum(r2c:r[-1]c)"
            End With
            .Offset(.Rows.Count).Cells(1).Value = "Total"
        End With
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            .Columns(1).NumberFormat = "000000"
            With .Rows(1)
                .Interior.ColorIndex = 44
                .BorderAround Weight:=xlThin
            End With
            With .Rows(.Rows.Count)
                .Interior.ColorIndex = 19
                .BorderAround Weight:=xlThin
            End With
            .Columns("a:b").ColumnWidth = Array(12, 9)
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub
klin89
 
Dernière édition:
Vote positif 0 Vote négatif
Re : VBA synthèse base de données sans doublons

Merci! est ce que vous pouvez juste me donner quelques commentaires pour le début du code svp..merci d'avance.. je suis un peu perdue.. je ne vois pas pourquoi on créée les variables : Mcol, col, mlign, et lign à la fois ?
 
Vote positif 0 Vote négatif
Re : VBA synthèse base de données sans doublons

Bonsoir,
j'essaie de mieux comprence ce code..mais j'ai toujours des difficulté à voir à quoi correspondent les variables Mlign et Mcol ?
mais surtout la partie en bleu...


Sub Stat2D()
Set f1 = Sheets("data")
Set d1 = CreateObject("Scripting.Dictionary")
Set d2 = CreateObject("Scripting.Dictionary")
Set d3 = CreateObject("Scripting.Dictionary")
Tbl = f1.Range("a2:d" & f1.[A65000].End(xlUp).Row)

For i = 1 To UBound(Tbl): d1(Tbl(i, 1)) = "": d2(Tbl(i, 3)) = "": Next
Dim TStat(): ReDim TStat(1 To d1.Count, 1 To d2.Count)
Dim Tcol: ReDim Tcol(1 To d2.Count): Dim Tlig: ReDim Tlig(1 To d1.Count)
lig = 1: col = 1
Mlig = lig: Mcol = col
d1.RemoveAll: d2.RemoveAll

For i = 1 To UBound(Tbl)
If d1.exists(Tbl(i, 1)) Then lig = d1(Tbl(i, 1)) Else d3(Tbl(i, 2)) = "": d1(Tbl(i, 1)) = Mlig: lig = Mlig: Mlig = Mlig + 1
If d2.exists(Tbl(i, 3)) Then col = d2(Tbl(i, 3)) Else d2(Tbl(i, 3)) = Mcol: col = Mcol: Mcol = Mcol + 1
TStat(lig, col) = TStat(lig, col) + Tbl(i, 4)
Tlig(lig) = Tlig(lig) + Tbl(i, 4)
Tcol(col) = Tcol(col) + Tbl(i, 4)
Next i

Set f2 = Sheets("synthèse")
f2.[a2].Resize(d1.Count, 1) = Application.Transpose(d1.keys)
f2.[b2].Resize(d3.Count, 1) = Application.Transpose(d3.keys)
f2.[c1].Resize(1, d2.Count) = d2.keys
f2.[c2].Resize(d1.Count, d2.Count) = TStat
f2.[c2].Offset(d1.Count).Resize(, d2.Count) = Tcol
f2.[c2].Offset(, d2.Count).Resize(d1.Count) = Application.Transpose(Tlig)

'-- tri
[a2].Resize(d1.Count, d2.Count + 3).Sort key1:=[a2], Header:=xlNo

'-- présentation
'f2.[c2].Resize(d1.Count, d2.Count).SpecialCells(4) = 0
f2.[a2].Resize(d1.Count, 1).BorderAround Weight:=xlThin
f2.[b2].Resize(d3.Count, 1).BorderAround Weight:=xlThin
f2.[c1].Resize(1, d2.Count + 1).BorderAround Weight:=xlThin
f2.[c2].Resize(d1.Count, d2.Count).BorderAround Weight:=xlThin
f2.[a2].Offset(d1.Count).Resize(, d2.Count + 3).BorderAround Weight:=xlThin
f2.[c1].Offset(, d2.Count).Resize(d1.Count + 2).BorderAround Weight:=xlThin
For k = 1 To d2.Count: f2.[c1].Offset(, k - 1).Resize(d1.Count + 2).BorderAround Weight:=xlThin: Next
End Sub
 
Vote positif 0 Vote négatif
Re : VBA synthèse base de données sans doublons

Bonjour,

-La BD est transférée dans une table Tbl(,) pour la rapidité d'accès.
-Les stats sont effectuées dans un tableau Tstat()
-Pour retrouver plus rapidement la ligne et la colonne du tableau Tstat(,) où effectuer le cumul, on indexe celui ci avec 2 dictionnaires d1 et d2
-Mlig représente le numéro de ligne maxi du dictionnaire d1. A chaque fois qu'une clé n'est pas trouvée dans le dictionnaire, on l'ajoute avec le numéro de ligne maxi.

Stat2D2.gif

JB
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
Re : VBA synthèse base de données sans doublons

ok merci je commence à comprendre!! Merci beaucoup!!

J'ai repris un code en l'adaptant à mon cas pour créer des boutons de navigation: premier, dernier, précédent, suivant..
cependant j'ai des erreurs.. avez vous des idées comment coder ces boutons.

Mon appli sur excel si besoin 😉

Merci d'avance! 🙂
 

Pièces jointes

Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

C
  • Question Question
Microsoft 365 Synthèse de données
2
Réponses
23
Affichages
962
Corinne
C
P
  • Question Question
XL 2016 Macro VBA remplissage tableau de synthèse % déchet ligne de production
Réponses
4
Affichages
79
vgendron
vgendron
M
  • Question Question
XL 2019 Transposer des données d'une feuille vers une autre sous forme de synthèse
Réponses
8
Affichages
317
mromain
mromain
S
  • Question Question
XL 2019 Fichier de tirage au sort sans doublons avec valeurs en plus
Réponses
1
Affichages
96
sylvanu
sylvanu
Orson83
  • Résolu(e)
XL 2010 Graphiques selon catégories (doublons) et répartitions
Réponses
9
Affichages
86
Orson83
Orson83
P
  • Question Question
XL 2019 Macro VBA SOMME.SI.ENS
Réponses
2
Affichages
65
sylvanu
sylvanu
S
  • Résolu(e)
Microsoft 365 [RESOLU] Excel : Calcul de prix en fonction d'un type
Réponses
4
Affichages
271
JHA
J
L
  • Résolu(e)
XL 2016 Pb publipostage conditionnelle avec base de données Excel
Réponses
1
Affichages
326
Linda42
L
P
  • Question Question
XL 2019 Macro VBA appliquer un filtre lors d'une importation de données
Réponses
1
Affichages
72
fanch55
fanch55
M
  • Résolu(e)
Autres extraire valeurs ligne par ligne sans doublons
Réponses
7
Affichages
315
mysti54
M
O
  • Résolu(e)
XL 2013 Formule ou Codage VBA qui met à jour un tableau en fonction de quantité
Réponses
5
Affichages
271
onyirimba
O
P
  • Question Question
XL 2016 VBA Appliquer un filtre sur mes données importées
Réponses
4
Affichages
98
sousou
sousou
C
  • Question Question
Autres RESOLU synthèse d'un tableau
Réponses
9
Affichages
441
chapipi
C
B
  • Question Question
Power Query Power Query
2
Réponses
26
Affichages
437
Brissou33
B
C
  • Question Question
Microsoft 365 Créer un synthèse de plusieurs onglets
Réponses
7
Affichages
498
cdric78
C
Syracoti
  • Question Question
XL 2021 Automatisation Extraction de données et de sommes
Réponses
1
Affichages
72
chris
chris
S
  • Question Question
Microsoft 365 Tableaux Structurées : récupérer des données uniques pour consolider un bilan
Réponses
4
Affichages
70
vgendron
vgendron
M
  • Question Question
XL 2021 Avoir des tableaux liés à une base de données
2
Réponses
24
Affichages
566
Nain porte quoi
N
M
  • Question Question
XL 2016 Analyse prix suivant hypothèse QTT à produire volume annuel et date de démarrage fabrication
Réponses
4
Affichages
92
mam721
M
J
  • Question Question
Microsoft 365 Naviguer dans un tableau pour copier des données dans un modèle et copier l'un derrière l'autre
Réponses
11
Affichages
157
AtTheOne
AtTheOne
Retour