Planning de transport - consolidation/synthèse dans un tableau à 2 entrées

Bonjour,

Je m´adresse à des fanatiques de formules complexes avec quelques notions de transport

A partir d´un planning de transport contenant la date de départ, le lieu de départ, le lieu de livraison, je souhaite consolider le tout dans un tableau synthétique.

Contrainte supplémentaire : le lieu de départ peut être bipoint

Je souhaite que le tableau synthétique me renvoie un résultat en fonction des paramètres d´entrées "date de départ" en ligne et "lieu de livraison" en colonne sous la forme X monopoint lieu de départ - lieu de livraison pour un monopoint et X bipoints lieu de départ 1 / lieu de départ 2 - lieu de livraison pour un bipoint.

Ci-joint un cas exemple qui illustre mes propos

Merci bcp pour vos pistes de résolution

JW

Bonjour,

Proposition avec une fonction personnalisée, la formule en B18 ( à tirer vers la droite et vers le bas) se résume ainsi à:

=extract($A18;B$17)

le code utilisé:

Option Compare Text
Function Extract(Date_Val As Date, Nom As String) As String
    DerCol = Range("A1").End(xlToRight).Column
    Texte = ""
    For i = 2 To DerCol Step 2
        If Cells(1, i) = Date_Val And Cells(2, i) = Nom Then
            Texte = Texte & Chr(10) & "+ " & Cells(8, i)
        End If
    Next i
    If Texte <> "" Then Extract = Right(Texte, Len(Texte) - 3)
End Function

Cdlt

Hello,

Merci pour ta réponse, c´est déjà super.

La cerise sur le gateau serait si tu pouvais trouver une solution pour additionner deux départ avec les mêmes critères (date de départ, lieu de départ, lieu de livraison)

Voir résultat obtenu avec ton code et résultat attendu dans la PJ ci-joint.

Merci d´avance

JW

Bonjour,

Ce que vous demandez est difficilement exploitable en l'état, pour cela j'ai opté pour une macro qui comptabilise les valeurs et ne tient pas compte des résultats obtenus par votre formule.

Il vous faudra cliquer sur le bouton pour rafraîchir les résultats.

Le code

Option Compare Text

Sub Extraction()
    Dim DerLig_Result As Long, DerCol_Result As Long, DerLig As Long, DerCol As Long
    Dim i As Long, j As Long, k As Long, c As Long, Nb_Date As Long
    Dim Cpt_MA As Long, Cpt_RM As Long, Cpt_QA As Long, Cpt_OR As Long
    Dim Date_Val As Date
    Dim Nom As String

    Application.ScreenUpdating = False
    DerLig_Result = Range("A" & Rows.Count).End(xlUp).Row 'Dernière ligne du tableau des résultats
    DerCol_Result = Range("B17").End(xlToRight).Column ' Dernière colonne du tableau des résultats
    DerLig = Range("A1").End(xlDown).Row ' Dernière ligne du tableau des valeurs
    DerCol = Range("ZZ1").End(xlToLeft).Column ' Dernière colonne du tableau des valeurs

    Range(Cells(18, "B"), Cells(DerLig_Result, DerCol_Result)).ClearContents

    For c = 2 To DerCol_Result 'Traitement pour chaque personne
        Nom = Cells(17, c)
        For i = 18 To DerLig_Result 'Traitement pour chaque date
            Date_Val = Cells(i, "A") 'Date à rechercher
            Nb_Date = Application.WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(1, DerCol)), Date_Val) 'nombre de fois où existe la date recherchée
            If Nb_Date <> 0 Then
                Pos_Date = Application.Match(CDbl(Date_Val), Range(Cells(1, 1), Cells(1, DerCol)), 0)
                For j = 3 To DerLig 'Pour chaque ligne dans la colonne traitée
                    For k = Pos_Date To Pos_Date + (Nb_Date * 2) - 2 Step 2 'Pour chaque colonne de la ligne à traiter
                        If Cells(2, k) = Nom Then 'si la position correspond au nom recherché alors,
                            If Cells(j, k) <> "" Then
                                Select Case j
                                    Case 3
                                        Cpt_MA = Cpt_MA + 1 'Comptage des "Massegros"
                                    Case 4
                                        Cpt_QA = Cpt_QA + 1 'Comptage de "LeBrou"
                                    Case 5
                                        Cpt_RM = Cpt_RM + 1 'Comptage des Riom"
                                    Case 6
                                        Cpt_OR = Cpt_OR + 1 'Comptage des "Orbec"
                                End Select
                            End If
                        End If
                    Next k
                Next j
            End If
            If Cpt_MA <> 0 Then Cells(i, c) = Cpt_MA & " Massegros" & Chr(10)
            If Cpt_QA <> 0 Then Cells(i, c) = Cells(i, c) & Cpt_QA & " LeBrou" & Chr(10)
            If Cpt_RM <> 0 Then Cells(i, c) = Cells(i, c) & Cpt_RM & " Riom" & Chr(10)
            If Cpt_OR <> 0 Then Cells(i, c) = Cells(i, c) & Cpt_OR & " Orbec" & Chr(10)
            Cpt_MA = 0
            Cpt_QA = 0
            Cpt_RM = 0
            Cpt_OR = 0
        Next i
    Next c
End Sub

Cdlt