Autres code VBA affichage de données

samia89 · 6 Août 2020

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"

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

fanch55 · 7 Août 2020

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

Autres code VBA affichage de données

samia89

XLDnaute Nouveau

Pièces jointes

fanch55

XLDnaute Barbatruc

Discussions similaires