Boucle recherche et recuperation de valeur en fonction d'une page

Bonjour,

Besoin d'aide, mais c'est compliqué à expliquer...

je suis bloquer, dans mon classeur j'ai une page Aller, une page grille kilomètrique et une page kms

Dans la page Aller, j'ai sur la colonne B des arrêts, dans la colonne D des horaires .

Dans la page grilles km un tableau présenté de la manière suivante:

Colonne A les points d'arrêts de départ, sur la ligne 2 les points d'arrêts d'arrivées, entre les kms entre chaque arrêt départ/ arrivée.

J'aimerai une boucle qui recherche dans la page Aller, chaque horaires rempli puis recherche dans la grille kilomètrique les kilomètres entre ce point d'arrêt et le précedent ayant un horaire rempli jusqu'a la dernière ligne remplie.

Voir fichier en exemple page kms.

Merci d'avance de votre aide et de votre patience

13exemple.xlsm (21.28 Ko)

Bonjour

Un essai à tester; Te convient-il ?

Bye !

14exemple-v1.xlsm (30.95 Ko)

Bonjour,

Merci pour ton travail,oui dans le principe, c'est ce que je cherche a faire. Mais la feuille Aller peut évolué et avoir des horaires jusqu'en Z et il faudrait que je puisse faire la même chose pour chaque colonne .

Bonsoir à tous,

A tester :

En fait la feuille "kms" est le miroir de la feuille "Aller" que tu devrais appeler "horaires", ça serait plus judicieux.

Option Explicit
Sub test()
Dim a, x, y, i As Long, lig As Long, col As Byte, derLig As Long, derCol As Byte
Dim dico As Object
    Set dico = CreateObject("Scripting.Dictionary")
    dico.CompareMode = 1
    a = Sheets("grille kms").Cells(1).CurrentRegion.Value
    With Sheets("Aller")
        derLig = .Cells(.Rows.Count, 2).End(xlUp).Row
        derCol = .Cells(8, .Columns.Count).End(xlToLeft).Column
        For col = 4 To derCol
            For lig = 8 To derLig
                If .Cells(lig, col).Value <> "-" Then
                    If dico.Count = 0 Then
                        dico(.Cells(lig, 2).Value) = 0
                    Else
                        dico(.Cells(lig, 2).Value) = Empty
                    End If
                End If
            Next
            For i = 1 To dico.Count - 1
                x = Application.Match(dico.keys()(i - 1), Application.Index(a, 0, 1), 0)
                y = Application.Match(dico.keys()(i), Application.Index(a, 2, 0), 0)
                dico.Item(dico.keys()(i)) = a(x, y)
            Next
            With Sheets("kms")
                For lig = 8 To derLig
                    If dico.exists(.Cells(lig, 2).Value) Then
                        .Cells(lig, col).Value = dico(.Cells(lig, 2).Value)
                    Else
                        .Cells(lig, col).Value = "-"
                    End If
                Next
            End With
            dico.RemoveAll
        Next
    End With
    Set dico = Nothing
End Sub

klin89

Bonjour,

Parfait!! Pouvez vous m'expliquer le code? Merci d'avance

Rechercher des sujets similaires à "boucle recherche recuperation valeur fonction page"