[Résolu]Listbox doublons avec plusieurs critère

[fouzyyy]

Bonjour

j'ai une base de donnés remplis a l'aide d'un userform (multipage). page concernat le véhicule et une page concerne la consommation carburant...voila tout ce pass bien sauf pour la partie ou je fais une recharche par date . selon 3 critére

1/critère= doublon + addition de leur valeur
2/critère= doublon + affiche grand valeur (kilométrage)
3/ critère = doublon + affiche petit valeur (kilométrage)

- la recherche par date c'est ok tout vas bien
- les doublons sont traiter et leur somme sont aditionne ...un peti hic adition de doublon avec le reste de véhicule non double ne passe pas bien .
- la partie ou je dois géré les doublon avec les valeur minimum et maximum de kilométrage Je sèche.


voila ce je veux si que ma liste box sera alimenter a a partir de la base des donnés avec :
les infos des véhicules sans doublon avec leur valeur ( addition de nombre des bons, kilométrage min, kilométrage max)
Ainsi je vais pouvoir remplir la feuil (model conso) sans doublons ...

je joins mon fichier pour bien comprendre mon cas
et merci infiniment

 

[Bebere]

bonjour
Fouzy puisque tu veux faire une historique par mois pas besoin de date ,juste l'index du mois
je te mets le fichier pas terminé(manque de temps)
dans consommation tu as un exemple avec des formules,mis commentaire dans code
je pense que immatriculation est de trop dans modele conso

 

[vgendron]

Hello
un autre essai pour la mise à jour du Total dans la Listbox

Private Sub GO4_Click()
Dim Debut As String, Fin As String
Dim S As Double, Total As Double
Dim Nblg As Long, lig As Long, L As Long
Dim Cel As Range, Plage As Range
Dim Dico, Tablo, P, m
Dim e, j As Integer
Dim Nombre As Double

TotalBonMois = ""

ConsoMois.Clear
ConsoMois.ColumnCount = 9

Debut = Me.Date4Deb4
If Not IsDate(Debut) Then
    MsgBox "Veuillez Choisir Une Date"
    Exit Sub
End If

Fin = Me.Date4Fin
If Not IsDate(Fin) Then
    MsgBox "Veuillez Choisir Une Date"
    Exit Sub
End If

Application.ScreenUpdating = False
With fc
    Nblg = .Range("B" & .Rows.Count).End(xlUp).Row 'dernière ligne
    Tablo = .Range("A5:K" & Nblg).Value
    Set Dico = CreateObject("Scripting.dictionary") 'dico des immat sans doublon
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        If Tablo(i, 1) >= CDate(Debut) And Tablo(i, 1) <= CDate(Fin) And Tablo(i, 2) <> "" Then
            If Not (Dico.Exists(Tablo(i, 3))) Then 'si c'est une nouvelle immat
                Dico.Item(Tablo(i, 3)) = CInt(Tablo(i, 8)) 'on l'ajoute au dictionnaire avec le NbrBon comme valeur
                Me.ConsoMois.AddItem 'on ajoutte dans la ListBox
                For j = LBound(Tablo, 2) + 1 To UBound(Tablo, 2) 'qu'on remplit avec les 9 colonnes: B à J
                    Me.ConsoMois.List(lig, j - 2) = Tablo(i, j)
                Next j
                lig = lig + 1
            Else 'l'immat a déjà été enregistrée
                Me.ConsoMois.List(lig - 1, 6) = CInt(Tablo(i, 8)) + Me.ConsoMois.List(lig - 1, 6) 'on met à jour le total dans la Listbox
            End If
        End If
    Next i
   
    j = ConsoMois.ListCount - 1
    For e = 0 To j
        Nombre = CDbl(ConsoMois.List(e, 6))
        S = CDbl(S) + CDbl(Nombre)
    Next
    TotalBonMois = S

End With
Application.ScreenUpdating = True
End Sub

 

[fouzyyy]

bonjour
Fouzy puisque tu veux faire une historique par mois pas besoin de date ,juste l'index du mois
je te mets le fichier pas terminé(manque de temps)
dans consommation tu as un exemple avec des formules,mis commentaire dans code
je pense que immatriculation est de trop dans modele conso

Bonjour bebere
Merci
cette application est pour but d’établir des états de consommation carburant , si vous constater dans mon fichier il y' une feuille nomme " model consos" qu elle doit être remplis par la page 'état carburant" si pour ca que je dois éliminer les doublons et additionner tout les bons consommer
par chaque véhicule La feuille Model conso ne doit pas y avoir des doublons ..
la date est nécessaire vu que chaque mois j'ai une quotas de bons (125 bons) par fois on les consomme dans un délais d'un mois et parfois moins d'un mois ainsi la date est nécessaire pour la base des donne pour avoir une traçabilité des bons
je tiens a vous remercie pour vos effort

Hello
un autre essai pour la mise à jour du Total dans la Listbox

Bonjour Vgendron

Ce dernier code est nickel tout marche bien même la listbox affiche tout les élément ..je vais essayer de le modifie un ti peu pour que je puisse avoir les valeur kilométrique Min et Maxi dans la liste box car ces valeur sont nécessaire pour calculer la moyen kilométrique d'un bon.

Je vous remercier

 

[Bebere]

bonjour
Fouzy version avec calcul et complète model conso

 

[fouzyyy]

bonjour
Fouzy version avec calcul et complète model conso

Bonsoir Bebere ..

Merci pour ces effort fourni que je considéré énormément votre aide; j' ai tester votre version est pas mal aussi ..cependant j'aimerais attire votre attention sur quelque points:

- quand je cherche entre 2 dates et le résultat de recherche est néant ( listbox vide) j'ai un bug sur cette ligne :

b = Application.Transpose(b)

- l' emplacement de nbr de bon quand je clique sur le button établir est positionne dans la colonne d'energy , car si a partir de la page "Archivage " que je vais imprimer les états ..

- les check box je ne peux pas cocher les 2 en meme temps car pour filtre les structure (parc01) ou( parc2) et aussi les 2 structure (c'est a dire consommation globale de 2 structure en même période).si pour cette raison que j'ai opter pour les checkbox au lieu de option button.

votre code pour retenir les kilometrage Maxi et min est superb...

voici ci joint un fichier fonctionnel sauf pour les critère filtrage retenir km Maxi et Mini que j'aimerais bien utiliser votre code avec ce fichier ..ainsi les checkbox ne filtre pas ..comme ca je vais pas perdre votre temps ainsi au autre membre...que j' apprécier énormément vos efforts

desoler pour ce dérangement car vraimant je suis au bout de mes force plus de 2 mois sur cette application ..

Merc bcp Bebere et tout les autre membre.....

 

[Bebere]

bonjour
fouzy regarde la feuille consomation testv4(fait des corrections dans le code et la feuille)
et de essai4b(les colonnes E,F,H contiennent du texte
sélectionne 2 cellules ou plus et tu verras que la somme ne se fait pas(en bas à droite)
tu as juste nb(non vides):2

 

[fouzyyy]

bonjour
fouzy regarde la feuille consomation testv4(fait des corrections dans le code et la feuille)

Bonsoir bebere
j'ai commencer a travailer sur votre proposition.. jai reusi a afficher les nombre des bons dans leur colonne dan la listbox et je vais continuer pour les autres...Merci encore bebere je vous tiens au courant....

de essai4b(les colonnes E,F,H contiennent du texte
sélectionne 2 cellules ou plus et tu verras que la somme ne se fait pas(en bas à droite)
tu as juste nb(non vides):2

oui aujourd'hui j'ai travailler avec l'application ou j'ai mis le code de vgnedron '(test) mais helas il y un ti problem...ou je m'adresse a vgendron

et le forum ...

voici un fichier joint avec 3 vhéhicule comme exemple..
l'addition dans totale des bons mois c'est ok...
mais par contre pk dans la listbox s'affiche
citreon.............................................................. 3 bon
peugeot .................................................................4 bon
renault..................................................................... 5 bon

or si on fait les calcul d'apres la base des donne (feuille consomation) on trouve ca :

citreon.............................................................. 5 bon
peugeot .................................................................4 bon
renault..................................................................... 3 bon

pk le 2 bon qui manque a citreon sont ajouter a renault ???
j'ai passer tout l’Après midi a changer ca ou la mais sans resultat...

 

[vgendron]

Bonjour

voir code corrigé ci dessous
'en cas de "doublon", le total n'était ps calculé sur la bonne ligne (prenait la précédente quelque soit le modèle)

Private Sub GO4_Click()

Dim Debut As String, Fin As String
Dim S As Double, Total As Double
Dim Nblg As Long, lig As Long, L As Long
Dim Cel As range, Plage As range
Dim Dico, Tablo, P, m
Dim e, j As Integer
Dim Nombre As Double

TotalBonMois = ""

ConsoMois.Clear
ConsoMois.ColumnCount = 9

Debut = Me.Date4Deb4
If Not IsDate(Debut) Then
    MsgBox "Veuillez Choisir Une Date"
    Exit Sub
End If

Fin = Me.Date4Fin
If Not IsDate(Fin) Then
    MsgBox "Veuillez Choisir Une Date"
    Exit Sub
End If

Application.ScreenUpdating = False
With fc
    Nblg = .range("B" & .Rows.Count).End(xlUp).Row 'dernière ligne
    Tablo = .range("A5:K" & Nblg).Value
    Set Dico = CreateObject("Scripting.dictionary") 'dico des immat sans doublon
    For i = LBound(Tablo, 1) To UBound(Tablo, 1)
        If Tablo(i, 1) >= CDate(Debut) And Tablo(i, 1) <= CDate(Fin) And Tablo(i, 2) <> "" Then
            If Not (Dico.Exists(Tablo(i, 3))) Then 'si c'est une nouvelle immat
                Dico.Item(Tablo(i, 3)) = CInt(Tablo(i, 8)) 'on l'ajoute au dictionnaire avec le NbrBon comme valeur
                Me.ConsoMois.AddItem 'on ajoutte dans la ListBox
                For j = LBound(Tablo, 2) + 1 To UBound(Tablo, 2) 'qu'on remplit avec les 9 colonnes: B à J
                    Me.ConsoMois.List(lig, j - 2) = Tablo(i, j)
                Next j
                lig = lig + 1
            Else 'l'immat a déjà été enregistrée
                For j = 0 To Me.ConsoMois.ListCount - 1
                    If Me.ConsoMois.List(j, 1) = Tablo(i, 3) Then
                        Me.ConsoMois.List(j, 6) = CInt(Tablo(i, 8)) + Me.ConsoMois.List(j, 6) 'on met à jour le total dans la Listbox
                        Exit For
                    End If
                Next j
               
            End If
        End If
    Next i
   
    j = ConsoMois.ListCount - 1
    For e = 0 To j
        Nombre = CDbl(ConsoMois.List(e, 6))
        S = CDbl(S) + CDbl(Nombre)
    Next
    TotalBonMois = S
NbrL.Caption = ConsoMois.ListCount
End With
Application.ScreenUpdating = True
End Sub

 

[Bebere]

bonjour
Fouzy version corrigée et enlever l'inutile
aussi corrigé les entrées dans feuille consomation

 

[fouzyyy]

Bonjour
voir code corrigé ci dessous
'en cas de "doublon", le total n'était ps calculé sur la bonne ligne (prenait la précédente quelque soit le modèle)

Bonjour Vgendron...Merci pour ce travail..

bonjour
Fouzy version corrigée et enlever l'inutile
aussi corrigé les entrées dans feuille consomation

bonjour Bebere....Merci encore

Je tiens a remercier tous Surtout vgendron & Bebere Mon problème est résolu.. , et apprécier énormément votre aide
je vais utiliser vos code pour avoir 2 version de cette application..

Un grand merci a vous.........

au faite comment on fait pour changer le statut de cette discussion pour affiche cette discussion comme résolu