Autres code VBA affichage de données

  • Initiateur de la discussion Initiateur de la discussion samia89
  • 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 !

samia89

XLDnaute Nouveau
bonsoir tt le monde j'ai vraiment besoin de votre aide SVP. vue mon niveau de débutant en VBA ça fait des jour que je galère pour résoudre mon problème

j'ai un classeur qui fonction très bien avec le code VBA actuelle,le classeur est composer de deux feuils une "detail" qui m'affiche le détail des sorties effectués par date et nom client sur trois tableau depuis la feuil "Mouvement" comme sur l'image ":

tableau1 "Agro" "A17:C44"
tableau 2 "légumes" "G17:I28"
tableau3"Fruit" L17:N28"
Exmple.JPG


mon problème si quand je change de nom du client qui y a fait les sortie uniquement pour "Agro" et "Fruit" il m'affiche juste les produit "Agro" si comme si il m'impose de faire les sorties pour la catégorie Légumes pour afficher les autre sorties svp je n’arrive pas a trouver la cause du problème dans le code que je vous joins et je vous joins le classeur.

VB:
Option Explicit
 
Dim fm As Worksheet, tablo, tabloR1(), tabloR2(), tabloR3()
Dim dico1 As Object, dico2 As Object, dico3 As Object, dico4 As Object, dico5 As Object, dico6 As Object
Dim i&, j&, k1&, k2&, k3&, dte As Date, client$
 
Private Sub Worksheet_Change(ByVal Target As Range)
 
    Application.EnableEvents = False
    If Target.Address = "$A$6" Or Target.Address = "$D$6" _
            And (Range("A6") <> "" And Range("D6") <> "") Then
 
        Set dico1 = CreateObject("Scripting.Dictionary")
        Set dico2 = CreateObject("Scripting.Dictionary")
 
        Set dico3 = CreateObject("Scripting.Dictionary")
        Set dico4 = CreateObject("Scripting.Dictionary")
 
        Set dico5 = CreateObject("Scripting.Dictionary")
        Set dico6 = CreateObject("Scripting.Dictionary")
 
        Set fm = Sheets("Mouvement")
        tablo = fm.Range(fm.Cells(3, 2), fm.Cells(fm.Range("B" & Rows.Count).End(xlUp).Row, 15))
        k1 = 0: k2 = 0: k3 = 0: dte = Range("A6"): client = Range("D6")
        For i = 1 To UBound(tablo, 1)
            If tablo(i, 1) = "Sortie" And tablo(i, 2) = dte And tablo(i, 3) = Range("D6") Then
 
                If tablo(i, 14) = "Agro" Then
                    If Not dico1.exists(tablo(i, 5)) Then
                        dico1(tablo(i, 5)) = tablo(i, 6)  'quantité
                        dico2(tablo(i, 5)) = tablo(i, 7)
                    Else
                        dico1(tablo(i, 5)) = dico1(tablo(i, 5)) + tablo(i, 6) 'quantité
                    End If
 
                ElseIf tablo(i, 14) = "Legumes" Then
                    If Not dico3.exists(tablo(i, 5)) Then
                        dico3(tablo(i, 5)) = tablo(i, 6)  'quantité
                        dico4(tablo(i, 5)) = tablo(i, 7)
                    Else
                        dico3(tablo(i, 5)) = dico3(tablo(i, 5)) + tablo(i, 6) 'quantité
                    End If
 
                ElseIf tablo(i, 14) = "Fruit" Then
                    If Not dico5.exists(tablo(i, 5)) Then
                        dico5(tablo(i, 5)) = tablo(i, 6)  'quantité
                        dico6(tablo(i, 5)) = tablo(i, 7)
                    Else
                        dico5(tablo(i, 5)) = dico5(tablo(i, 5)) + tablo(i, 6) 'quantité
                    End If
 
                End If
            End If
        Next i
    End If
 
    Range("A17:C44,G17:I28,L17:N28").ClearContents
    If Range("A6") = "" Or Range("D6") = "" Then GoTo fin
    On Error GoTo fin
 
    Range("A17").Resize(dico1.Count, 1) = Application.Transpose(dico1.keys)
    Range("B17").Resize(dico1.Count, 1) = Application.Transpose(dico1.items)
    Range("C17").Resize(dico1.Count, 1) = Application.Transpose(dico2.items)
 
    Range("G17").Resize(dico3.Count, 1) = Application.Transpose(dico3.keys)
    Range("H17").Resize(dico3.Count, 1) = Application.Transpose(dico3.items)
    Range("I17").Resize(dico3.Count, 1) = Application.Transpose(dico4.items)
 
    Range("L17").Resize(dico5.Count, 1) = Application.Transpose(dico5.keys)
    Range("M17").Resize(dico5.Count, 1) = Application.Transpose(dico5.items)
    Range("N17").Resize(dico5.Count, 1) = Application.Transpose(dico6.items)
fin:
    Application.EnableEvents = True
End Sub
 
Sub Evenement()
    Application.EnableEvents = True
End Sub
Merci a vous tous excellente soirée
 

Pièces jointes

Salut,
Vous avez une clause "on error goto fin" avant de faire les Resize des Zones.
Comme il n'y a pas de "Légumes", Dico3.count=0 ....🙄 ==> erreur dans les resize ==> Fin
Testez le nombre des dicox.count

VB:
'    On Error GoTo fin
    If dico1.Count > 0 Then
        Range("A17").Resize(dico1.Count, 1) = Application.Transpose(dico1.keys)
        Range("B17").Resize(dico1.Count, 1) = Application.Transpose(dico1.items)
        Range("C17").Resize(dico1.Count, 1) = Application.Transpose(dico2.items)
    End If
    If dico3.Count > 0 Then
        Range("G17").Resize(dico3.Count, 1) = Application.Transpose(dico3.keys)
        Range("H17").Resize(dico3.Count, 1) = Application.Transpose(dico3.items)
        Range("I17").Resize(dico3.Count, 1) = Application.Transpose(dico4.items)
    End If
    If dico5.Count > 0 Then
        Range("L17").Resize(dico5.Count, 1) = Application.Transpose(dico5.keys)
        Range("M17").Resize(dico5.Count, 1) = Application.Transpose(dico5.items)
        Range("N17").Resize(dico5.Count, 1) = Application.Transpose(dico6.items)
    End If
fin:
    Application.EnableEvents = True
 
- 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

Réponses
5
Affichages
379
Réponses
4
Affichages
332
  • Question Question
Microsoft 365 Export données
Réponses
4
Affichages
481
  • Question Question
Microsoft 365 VBA Transpose
Réponses
11
Affichages
727
  • Question Question
Microsoft 365 Code VBA
Réponses
7
Affichages
622
Réponses
33
Affichages
2 K
Réponses
2
Affichages
371
Réponses
3
Affichages
569
Réponses
12
Affichages
468
Retour