XL 2019 remplir Listview par dictionnaire

[akni]

Bonjour Tout le monde,

J'ai une data ventes qui devient au fil des mois de plus en plus volumineuse le traitement dans la feuille par les filtres et tri deviens très lent
y'a t-il possibilité d'utiliser dictionnaire pour remplir un listview dans un userform pour faire ressortir par exemple les ventes
par client et par année. (je ne veux pas passer par TCD).
ci joint type de data (données anonymes)

Merci pour toute aide.

 

[job75]

Bonjour akni,

Les ListViews ne sont généralement pas acceptées sur les versions récentes d'Excel.

J'utilise donc ici une ListBox de 7 colonnes, remplie par sa propriété RowSource.

Voyez le fichier joint et la macro affectée au bouton :

Sub Grouper()
Dim d As Object, ncol%, tablo, s$, i&, x$, n&, nn&, j%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ncol = 7 'nombre de colonnes
tablo = Feuil1.[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide
s = Chr(1) 'séparateur
For i = 1 To UBound(tablo)
    x = tablo(i, 1) & s & tablo(i, 2) & s & tablo(i, 3) & s & tablo(i, 4) & s & tablo(i, 5) & s & tablo(i, 6)
    If Not d.exists(x) Then
        n = n + 1
        d(x) = n 'mémorise la ligne
    End If
    nn = d(x)
    If IsNumeric(tablo(i, 7)) Then tablo(nn, 7) = tablo(nn, 7) + CDbl(tablo(i, 7))
    For j = 1 To ncol - 1
        tablo(nn, j) = tablo(i, j)
Next j, i
'---restitution en 2ème feuille---
With Feuil2 'CodeName
    .UsedRange.ClearContents 'RAZ
    .[A1].Resize(nn, ncol) = tablo
    If nn > 1 Then .[A2].Resize(nn - 1, ncol).Name = "Source" 'plage nommée
End With
'---ouverture de l'UserForm---
With UserForm1
    .ListBox1.RowSource = IIf(nn > 1, "Source", "")
    .Show
End With
End Sub

Elle est très rapide car on utilise un tableau VBA et le Dictionary.

A+

 

[akni]

Bonjour akni,

Les ListViews ne sont généralement pas acceptées sur les versions récentes d'Excel.

J'utilise donc ici une ListBox de 7 colonnes, remplie par sa propriété RowSource.

Voyez le fichier joint et la macro affectée au bouton :

Sub Grouper()
Dim d As Object, ncol%, tablo, s$, i&, x$, n&, nn&, j%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ncol = 7 'nombre de colonnes
tablo = Feuil1.[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide
s = Chr(1) 'séparateur
For i = 1 To UBound(tablo)
    x = tablo(i, 1) & s & tablo(i, 2) & s & tablo(i, 3) & s & tablo(i, 4) & s & tablo(i, 5) & s & tablo(i, 6)
    If Not d.exists(x) Then
        n = n + 1
        d(x) = n 'mémorise la ligne
    End If
    nn = d(x)
    If IsNumeric(tablo(i, 7)) Then tablo(nn, 7) = tablo(nn, 7) + CDbl(tablo(i, 7))
    For j = 1 To ncol - 1
        tablo(nn, j) = tablo(i, j)
Next j, i
'---restitution en 2ème feuille---
With Feuil2 'CodeName
    .UsedRange.ClearContents 'RAZ
    .[A1].Resize(nn, ncol) = tablo
    If nn > 1 Then .[A2].Resize(nn - 1, ncol).Name = "Source" 'plage nommée
End With
'---ouverture de l'UserForm---
With UserForm1
    .ListBox1.RowSource = IIf(nn > 1, "Source", "")
    .Show
End With
End Sub

Elle est très rapide car on utilise un tableau VBA et le Dictionary.

A+

Bonjour Job75,
Merci beaucoup pour votre code et fichier joint, c'est rapide à l'exécution.

Merci encore.

 

[job75]

La macro précédente n'allait pas, il faut le tableau resu :

Sub Grouper()
Dim d As Object, ncol%, tablo, resu(), s$, i&, x$, n&, nn&, j%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ncol = 7 'nombre de colonnes
tablo = Feuil1.[A1].CurrentRegion.Resize(, ncol) 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To ncol)
resu(1, ncol) = tablo(1, ncol)
s = Chr(1) 'séparateur
For i = 1 To UBound(tablo)
    x = tablo(i, 1) & s & tablo(i, 2) & s & tablo(i, 3) & s & tablo(i, 4) & s & tablo(i, 5) & s & tablo(i, 6)
    If Not d.exists(x) Then
        n = n + 1
        d(x) = n 'mémorise la ligne
    End If
    nn = d(x)
    If IsNumeric(tablo(i, ncol)) Then resu(nn, ncol) = resu(nn, ncol) + CDbl(tablo(i, ncol))
    For j = 1 To ncol - 1
        resu(nn, j) = tablo(i, j)
Next j, i
'---restitution en 2ème feuille---
With Feuil2 'CodeName
    .UsedRange.ClearContents 'RAZ
    .[A1].Resize(n, ncol) = resu
    If n > 1 Then .[A2].Resize(n - 1, ncol).Name = "Source" 'plage nommée
End With
'---ouverture de l'UserForm---
With UserForm1
    .ListBox1.RowSource = IIf(n > 1, "Source", "")
    .Show
End With
End Sub

Prenez ce fichier (2).

Bonne nuit.

 

[ChTi160]

Bonjour akni
Bonjourjob75

akni tu dis :

par client et par année.

Comment tu vois la Chose pour ce qui est du classement par Année ?
jean marie

 

[job75]

Bonjour ChTi160,

Si l'on veut étudier les années il faut évidemment une colonne avec les dates.

Et une liste de choix pour les filtrer, fichier (3) avec la macro :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J2]) Is Nothing Then Exit Sub
Dim d As Object, ncol%, an, tablo, resu(), s$, i&, x$, n&, nn&, j%
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
ncol = 8 'nombre de colonnes
an = [J2]
tablo = Feuil1.[A1].CurrentRegion.Resize(, ncol).Value2 'matrice, plus rapide
ReDim resu(1 To UBound(tablo), 1 To ncol - 1) 'la colonne A n'est pas restituée
resu(1, ncol - 1) = tablo(1, ncol)
s = Chr(1) 'séparateur
For i = 1 To UBound(tablo)
    If i = 1 Or Year(Val(tablo(i, 1))) = an Or an = "" Then
        x = tablo(i, 2) & s & tablo(i, 3) & s & tablo(i, 4) & s & tablo(i, 5) & s & tablo(i, 6) & s & tablo(i, 7)
        If Not d.exists(x) Then
            n = n + 1
            d(x) = n 'mémorise la ligne
        End If
        nn = d(x)
        If IsNumeric(tablo(i, ncol)) Then resu(nn, ncol - 1) = resu(nn, ncol - 1) + CDbl(tablo(i, ncol))
        For j = 2 To ncol - 1
            resu(nn, j - 1) = tablo(i, j)
        Next j
    End If
Next i
'---restitution en 2ème feuille---
With Feuil2 'CodeName
    .UsedRange.ClearContents 'RAZ
    .[A1].Resize(n, ncol - 1) = resu
    If n > 1 Then .[A2].Resize(n - 1, ncol - 1).Name = "Source" 'plage nommée
End With
'---ouverture de l'UserForm---
With UserForm1
    .Caption = IIf(an = "", "Toutes années", "Année " & an)
    .ListBox1.RowSource = IIf(n > 1, "Source", "")
    .Show
End With
End Sub

A+

 

[ChTi160]

Merci job75
Je m'en serais douté lol
merci
J'attends des nouvelles du demandeur et un fichier lol
bonne fin de journée
Jean marie

 

[akni]

Bonjour Job75, ChTi160

Merci beaucoup pour votre aide, Job75 votre dernier code est super.
je vais essayer de comprendre le principe et essayer d'ajouter d'autres filtres si j'arrive.

Merci aussi d'avoir ajouter la colonne date je l'avais oublié.


Thanks a lot.

 

[akni]

Bonjour Job75,

une question svp, les variables déclarées (ncol%, an, tablo, resu(), s$, i&, x$, n&, nn&, j%) sont de quel type
parce que je ne vois pas de "as + type de variable"
et le %, &, $ a-t-il une signification précise?

Merci pour ton aide

 

[job75]

Bonsoir akni,

x& c'est la même chose que x As Long

x% c'est la même chose que x As Integer

x$ c'est la même chose que x As String.

A+

 

[ChTi160]

Tiré d'une recherche sur le net​

(Excel pratique)​

Voir dernière colonne du tableau .

LES TYPES DE VARIABLES​

Nom	Type	Détails	Symbole
Byte	Numérique	Nombre entier de 0 à 255.
Integer	Numérique	Nombre entier de -32'768 à 32'767.	%
Long	Numérique	Nombre entier de - 2'147'483'648 à 2'147'483'647.	&
Currency	Numérique	Nombre à décimale fixe de -922'337'203'685'477.5808 à 922'337'203'685'477.5807.	@
Single	Numérique	Nombre à virgule flottante de -3.402823E38 à 3.402823E38.	!
Double	Numérique	Nombre à virgule flottante de -1.79769313486232E308 à 1.79769313486232E308.	#
String	Texte	Texte.	$
Date	Date	Date et heure.
Boolean	Boolean	True (vrai) ou False (faux).
Object	Objet	Objet.
Variant	Tous	Tout type de données (type par défaut si la variable n'est pas déclarée).

Bonsoir job75
Jean marie

 

[akni]

Bonsoir Job75, ChTi160,

Merci beaucoup pour cette explication.

A+