Synthèse de tableau

Bonjour,

j'aimerais avoir votre aide pour faire un tableau de synthèse.

J'ai un tableau de suivi et j'aimerais faire une mise en page spécifique par mois

je vous met un exemple

Dans l'onglet suivi voiture j'ai mon tableau général

et sur l'onglet mois j'ai mon tableau de synthèse avec en B1 la première condition et en D1 la Deuxième condition

je m'explique:

je trie déjà par type de voiture colonne J

après je trie par date de prise en main colonne C (je rentre la date que j'ai en B1)

et je copie la voiture (colonne A) et le chauffeur correspondant (colonne B)

après je trie par date de contrôle technique (colonne E).

et je copie (si pas déjà présent ) la voiture (colonne A) et le chauffeur pour le contrôle technique (colonne D)

ect....

j’espère avoir été clair

je vous remercie d'avance

Bonjour,

Ton besoin serait de remplir automatiquement le tableau synthèse en fonction du mois et du type de voiture?

bonjour

un essai

j'ai fait en"dur" ; il faudrai nommer les plages

les formules sont matricielles

cordialement

Audebois a écrit :

Bonjour,

Ton besoin serait de remplir automatiquement le tableau synthèse en fonction du mois et du type de voiture?

non simplement en fonction du mois

je recherche tous se qui correspond au mois demandé et je fais la synthèse de mon tableau par rapport a ce mois

bonjour

sans formules compliquée, avec une zone MIRoir et une colonne de pointage (formule à base de SI

il suffit ensuite de filtrer la valeur 1 sur cette colonne

bonjour JMD

en effet cela semble +simple

mais cela ne supprime pas les valeurs non desirées qui se trouvent sur la meme ligne

cordialement

Bonsoir à tous,

Essaie ceci :

Option Explicit
Sub test()
Dim a, b(), i As Long, j As Byte, n As Long
Dim dico1 As Object, dico2 As Object
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    With Sheets("Suivi Voiture").Range("A1").CurrentRegion
        a = .Value
        For j = 2 To UBound(a, 2) - 2 Step 2
            dico1(a(1, j)) = dico1.Count + 2
        Next
        ReDim b(1 To UBound(a, 1) - 1, 1 To dico1.Count + 1)
        For i = 2 To UBound(a, 1)
            If UCase(a(i, UBound(a, 2))) = UCase(Sheets("Mois").Range("d1").Value) Then
                For j = 3 To UBound(a, 2) Step 2
                    If a(i, j) = Sheets("Mois").Range("b1").Value Then
                        If Not dico2.exists(a(i, 1)) Then
                            n = n + 1
                            b(n, 1) = a(i, 1)
                            dico2.Item(a(i, 1)) = n
                        End If
                        b(dico2.Item(a(i, 1)), dico1.Item(a(1, j - 1))) = a(i, j - 1)
                    End If
                Next
            End If
        Next
    End With
    With Sheets("Mois").Range("A4")
        .CurrentRegion.Offset(1).Clear
        If n > 0 Then
            .Offset(1).Resize(n, UBound(b, 2)).Value = b
        Else
            MsgBox "aucune donnée"
        End If
    End With
    Set dico1 = Nothing: Set dico2 = Nothing
End Sub

klin89

Re nounours69100,

Pour le fun

Option Explicit
Sub test()
Dim a(), b(), i As Long, j As Byte, n As Long, x(), y()
Dim dico1 As Object, dico2 As Object
    Application.ScreenUpdating = False
    Set dico1 = CreateObject("Scripting.Dictionary")
    dico1.CompareMode = 1
    Set dico2 = CreateObject("Scripting.Dictionary")
    dico2.CompareMode = 1
    With Sheets("Suivi Voiture").Range("A1").CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:1)"), Array(2, 4, 6, 8))
        'a = Application.Index(.Value, Evaluate("rows(1)"), Array(2, 4, 6, 8))
        For i = 1 To UBound(a)
            dico1(a(i)) = dico1.Count + 2
        Next
        ReDim b(1 To .Rows.Count - 1, 1 To dico1.Count + 1)
        For i = 2 To .Rows.Count
            x = Application.Index(.Value, Evaluate("row(" & i & ":" & i & ")"), Array(1, 3, 5, 7, 9))
            y = Application.Index(.Value, Evaluate("row(" & i & ":" & i & ")"), Array(2, 4, 6, 8))
            If UCase(.Cells(i, .Columns.Count).Value) = UCase(Sheets("Mois").Range("d1").Value) And _
               Not IsError(Application.Match(CStr(Sheets("Mois").Range("b1").Value), x, 0)) Then
                For j = 2 To UBound(x)
                    If CDate(x(j)) = Sheets("Mois").Range("b1").Value Then
                        If Not dico2.exists(x(1)) Then
                            n = n + 1
                            b(n, 1) = x(1)
                            dico2.Item(x(1)) = n
                        End If
                        b(dico2.Item(x(1)), dico1.Item(a(j - 1))) = y(j - 1)
                    End If
                Next
            End If
        Next
    End With
    With Sheets("Feuil1").Range("A4")
        .CurrentRegion.Offset(1).Clear
        If n > 0 Then
            .Offset(1).Resize(n, UBound(b, 2)).Value = b
        Else
            MsgBox "aucune donnée"
        End If
    End With
    Application.ScreenUpdating = True
End Sub

klin89