Résolu VBA compter occurrences tableau variable

Mickoik · 22 Janvier 2018

Bonjour,
j'ai fait une macro qui fonctionne parfaitement et qui me donne un tableau variable que j'affiche dans une listbox.
je n'arrive pas à compter le nombre d’occurrences identiques dans mon tableau variable avec de l'afficher dans la list box.
Une idée ?

Code:

'recherche du matériel
Dim tab_donnees()
Dim tab_recup()

Dim derligne_donnees As Integer


' je recupère ma base
derligne_donnees = Sheets("Gestion des installations").Range("O" & Rows.Count).End(xlUp).Row

ReDim tab_donnees(derligne_donnees, 8)

    For i = 1 To derligne_donnees
        tab_donnees(i, 0) = Sheets("Gestion des installations").Range("A" & i) 'client
        tab_donnees(i, 1) = Sheets("Gestion des installations").Range("M" & i) 'date
        tab_donnees(i, 2) = Sheets("Gestion des installations").Range("N" & i) 'nombre de cameras
        tab_donnees(i, 3) = Sheets("Gestion des installations").Range("O" & i) 'type camera
        tab_donnees(i, 4) = Sheets("Gestion des installations").Range("P" & i) 'type ecran
        tab_donnees(i, 5) = Sheets("Gestion des installations").Range("Q" & i) 'type dvr
        tab_donnees(i, 6) = Sheets("Gestion des installations").Range("R" & i) 'type DD
        tab_donnees(i, 7) = Sheets("Gestion des installations").Range("S" & i) 'type alim
    
    Next



' je compte le nombre de ligne de mon tableau resultats

For i = LBound(tab_donnees, 1) To UBound(tab_donnees, 1)

If clientbox = tab_donnees(i, 0) Then

n = n + 1

End If

Next

 
' je charge mon tableau de resultats et transforme mon tableau en 3 colonnes en comblant les trous
If Not installbox.text = "" Then
Dim derligne_recup As Integer

derligne_recup = n * 5

 
ReDim tab_recup(derligne_recup, 2)

Dim client As String
Dim date_ins As Date

client_box_rec = clientbox.text
date_ins = installbox.text


k = 1
For i = LBound(tab_donnees, 1) To UBound(tab_donnees, 1)
 
    If client_box_rec = tab_donnees(i, 0) And date_ins = CDate(tab_donnees(i, 1)) Then



 
tab_recup(k, 0) = tab_donnees(i, 2) 'nb de matos
       tab_recup(k, 1) = tab_donnees(i, 3) 'matos

 
 
       If Not tab_donnees(i, 4) = "" Then
       tab_recup(k + 1, 1) = tab_donnees(i, 4)

       End If
 
       If Not tab_donnees(i, 5) = "" Then
       tab_recup(k + 2, 1) = tab_donnees(i, 5)

       End If
 
       If Not tab_donnees(i, 6) = "" Then
       tab_recup(k + 3, 1) = tab_donnees(i, 6)

       End If
 
       If Not tab_donnees(i, 7) = "" Then
       tab_recup(k + 4, 1) = tab_donnees(i, 7)

       End If

k = k + 5
End If
Next




Me.listMatos.AddItem
listMatos.List = tab_recup
End If

drul · 23 Janvier 2018

Pas compris ...

Mickoik · 23 Janvier 2018

drul :

à la fin de la macro quand ma listbox se charge, il peut me mettre comme resultat :
cam x
cam x
cam x
ecran x

j'aurais préféré :
3 cam x
1 ecran x

drul · 23 Janvier 2018

T'es exigeant toi

...
Ton tableau est trié ou non ?

Mickoik · 23 Janvier 2018

drul :

non

t1cable:

drul · 23 Janvier 2018

Ok, plusieurs solutions s'offrent à toi ...
La lente, mais basique:
- double boucle a travers le tableau, pour chaque valeurs tu regarde combien il y a d'élément similaire et tu les comptes, et tu passes par un nouveau tableau ...
- L'utilisation d'un dictionnaire à la place du tableau qui permet de voir facilement si un élément à déjà été inséré, tu ferais donc le compte à la création du tableau ...

Mickoik · 23 Janvier 2018

drul :

Ok, plusieurs solutions s'offrent à toi ...
La lente, mais basique:
- double boucle a travers le tableau, pour chaque valeurs tu regarde combien il y a d'élément similaire et tu les comptes, et tu passes par un nouveau tableau ...
- L'utilisation d'un dictionnaire à la place du tableau qui permet de voir facilement si un élément à déjà été inséré, tu ferais donc le compte à la création du tableau ...

tu veux bien m'apprendre à faire la deuxième ?

drul · 23 Janvier 2018

Jette déjà un oeil ici, c'est très bien expliqué (si l'anglais n'est pas un problème pour toi ...) https://excelmacromastery.com/vba-dictionary/

drul · 23 Janvier 2018

Non,là tu reboucles APRES la création des tableaux, et donc le dico ne sert à rien (en plus d'être mal utilisé...)
Ce que je pensais c'est remplacer le premier tableau par un dictionnaire
Ce que tu appelles matos, c'est bien ce qui est contenu dans: tab_donnees(i, 2) = Sheets("Gestion des installations").Range("N" & i) 'nombre de cameras ?

Mickoik · 23 Janvier 2018

drul :

non c'est plutôt tab_recup(k, 1) qui représente une colonne avec les éléments successifs installés

Mickoik · 23 Janvier 2018

comment je fais pour afficher dict dans une listbox à 2 colonnes ?

Code:

Set dict = CreateObject("Scripting.Dictionary")

 
Dim matos_dict As String
Dim qte_matos As Long
Dim o As Long
 
For o = 0 To k
matos_dict = tab_recup(o, 1)
qte_matos = tab_recup(o, 0)
dict(matos_dict) = dict(matos_dict) + qte_matos
Next o


Me.listMatos.AddItem
listMatos.List = dict

drul · 23 Janvier 2018

j'essaye demain, mais c'est surement moins facile qu'avec un tableau :/

drul · 24 Janvier 2018

SAlut, un petit exemple ici:

Code:

Sub test()

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim a(2) As String
For i = 1 To 9
    For j = 1 To 2
      a(j) = "toto" & j
    Next
    dict.Add i, a
Next
With ListBox21
    .ColumnCount = 9
    .ColumnWidths = "60;60;60"
    .List = Application.Transpose(Application.Transpose(dict.Items))
End With
End Sub

La double transposition est nécessaire pour avoir un tableau qui part de 1 et non de 0.

N.B. le but d'utiliser un dictionnaire, c'est de profiter de dict.exists pour identifier si un élément est déjà présent dans le tableau, et dans ce cas lui augmenter la "quantité"

drul · 24 Janvier 2018

DAns l'idée ça donnerait un truc du genre:

Code:

Dim tab_donnees()
Dim tab_recup()
 
Dim derligne_donnees As Integer
 
' je recupère ma base
derligne_donnees = Sheets("Gestion des installations").Range("O" & Rows.Count).End(xlUp).Row
 
ReDim tab_donnees(derligne_donnees, 8)
 
    For i = 1 To derligne_donnees
        tab_donnees(i, 0) = Sheets("Gestion des installations").Range("A" & i) 'client
        tab_donnees(i, 1) = Sheets("Gestion des installations").Range("M" & i) 'date
        tab_donnees(i, 2) = Sheets("Gestion des installations").Range("N" & i) 'nombre de cameras
        tab_donnees(i, 3) = Sheets("Gestion des installations").Range("O" & i) 'type camera
        tab_donnees(i, 4) = Sheets("Gestion des installations").Range("P" & i) 'type ecran
        tab_donnees(i, 5) = Sheets("Gestion des installations").Range("Q" & i) 'type dvr
        tab_donnees(i, 6) = Sheets("Gestion des installations").Range("R" & i) 'type DD
        tab_donnees(i, 7) = Sheets("Gestion des installations").Range("S" & i) 'type alim
    Next
 
' je charge mon tableau de resultats et transforme mon tableau en 3 colonnes en comblant les trous
If Not installbox.Text = "" Then
 
Dim dict As New Scripting.Dictionary
Set dict = New Scripting.Dictionary
Dim tab_recup(1)

Dim client As String
Dim date_ins As Date
 
client_box_rec = clientbox.Text
date_ins = installbox.Text
 
For i = LBound(tab_donnees, 1) To UBound(tab_donnees, 1)
 
    If client_box_rec = tab_donnees(i, 0) And date_ins = CDate(tab_donnees(i, 1)) Then
 
       If tab_donnees(i, 2) = "" Then
            tab_recup(0) = 1
       Else
            tab_recup(0) = tab_donnees(i, 2) 'nb de matos
       End If
       tab_recup(1) = tab_donnees(i, 3) 'matos
       If dict.Exists(tab_recup(1)) Then
            tab_recup(0) = dict.Items(tab_recup(1))(0) + tab_recup(0) ' on additionne
            dict.Items(tab_recup(1)) = tab_recup
       Else
            dict.Add tab_recup(0), tab_recup
 
      For j = 4 To 7
           If Not tab_donnees(i, j) = "" Then
                tab_recup(1) = tab_donnees(i, j)
                tab_recup(0) = 1
           End If
           If dict.Exists(tab_recup(1)) Then 'si il y a déjà un élément de ce type
                tab_recup(0) = dict.Items(tab_recup(1))(0) + tab_recup(0) ' on additionne
                dict.Items(tab_recup(1)) = tab_recup 'et on assign dans le dico
           Else
                dict.Add tab_recup(0), tab_recup ' sinon on crée une nouvelle entrée dans le dico
           End If
      Next
 

 
End If
Me.listMatos.AddItem
listMatos.List = Application.Transpose(Application.Transpose(dict.Items))

Résolu VBA compter occurrences tableau variable

Mickoik

drul

Mickoik

drul

Mickoik

drul

Mickoik

drul

drul

Mickoik

Mickoik

drul

drul

drul