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