XL 2016 [Résolu] Calcul d'itinéraire

[eddy1975]

Bonsoir le forum,

Je rencontre des soucis dans un fichier de TATIAK que j'ai téléchargé sur le Forum et que j'essaye d'adapter.
Dans l'exemple ou j'ai renseigné la ville de départ (Paris) en H3 et la destination (Moscou) en H4, j'ai deux soucis :
- la durée ne correspond pas, il devrait y avoir plus de 30 heures en E3.
- lorsque les cellules H3 et H4 sont vides et que je clique sur le bouton " Calcul.." les cellules B3 et C3 sont vides elles aussi mais D3 et E3 conservent les données de la précédente recherche. J'aimerais qu'elles soient également vides.
Merci pour votre aide.
@+

 

[Lone-wolf]

Bonjour D4

Quelle idée de mettre plus d'un milion de ligne si aux max tu en as 1000. Modifie cette partie

If Sheets("Feuil1").Range("a3") <> "" And Sheets("Feuil1").Range("b3") <> "" And Sheets("Feuil1").Range("c2") <> "" And Sheets("Feuil1").Range("d2") <> "" Then
If Sheets("Routes").Range("a1048576").End(xlUp) = "REFERENCE" Then
Sheets("Routes").Range("a1048576").End(xlUp).Offset(1, 0) = 1
Else
Sheets("Routes").Range("a1048576").End(xlUp).Offset(1, 0) = Sheets("Routes").Range("a1048576").End(xlUp) + 1
End If
Sheets("Routes").Range("b1048576").End(xlUp).Offset(1, 0) = Sheets("Feuil1").Range("a3")
Sheets("Routes").Range("c1048576").End(xlUp).Offset(1, 0) = Sheets("Feuil1").Range("b3")
Sheets("Routes").Range("d1048576").End(xlUp).Offset(1, 0) = Sheets("Feuil1").Range("c2")
Sheets("Routes").Range("e1048576").End(xlUp).Offset(1, 0) = Sheets("Feuil1").Range("d2")
Sheets("Routes").Range("f1048576").End(xlUp).Offset(1, 0) = Sheets("Feuil1").Range("h2")
Sheets("Routes").Range("g1048576").End(xlUp).Offset(1, 0) = Sheets("Feuil1").Range("j2")

Par

Dim WsF As WorkSheet, WsR As WorkSheet
Dim plage As Range, cel As Range
Dim derlig As Long, lig As Long

Set WsF = Sheets("Feuil1") : Set WsR = Sheets("Routes")

With WsF
If Not IsEmpty(.Range("a3")) <> "" And Not IsEmpty(.Range("b3")) _
And Not IsEmpty(.Range("c2")) And Not IsEmpty(.Range("d2")) Then

With WsR
derlig = .Range("a" & Rows.Count).End(xlUp)
lig = .Range("a" & Rows.Count).End(xlUp) + 1
Set plage = .Range("a2:a" & derlig)

For each cel in plage
If cel Like "*REFERENCE*" Then
cel.Offset(1, 0) = 1
Else
cel.Offset(1, 0) = WsR.Range("a" & lig)
End If
cel.Offset(1, 1) = WsF.Range("a3")
cel.Offset(1, 2) = WsF.Range("b3")
cel.Offset(1, 3)= WsF.Range("c2")
cel.Offset(1, 4) = WsF.Range("d2")
cel.Offset(1, 5) =WsF .Range("h2")
cel.Offset(1, 6) = WsF.Range("j2")
Next cel
End With
End With

 

[Lone-wolf]

Bonjour Pierre

Moi habituellement j'utilise Smart Identer, le code que je viens d'écrire je l'ai fait avec Notepad.

 

[Lone-wolf]

Re

D'accord papa

En pj, avec ajout de conditions pour ne pas avoir des zéro partout.

 

[D4_]

Hello,

Lone_Wolf : Je ne comprend pas ton code, quand je le lance, j'ai des erreurs de "End with sans with, et End if sans if" alors que tout est correct...
Et je ne comprend pas comment ça pourrait régler le problème que j'ai énoncé, dont la cause est pour moi inconnue puisque je n'ai pas touché au code de Tatiak et qu'il fonctionnait pendant mes ajout.

Tatiak : Encore mieux ton fichier, mais je peux pas affecter la macro Get_trajet à un bouton
et je préférais utiliser une autre feuille pour le listing, mais de toute façon ce n'est qu'un fichier test pour le moment. (Je préférais également éviter d'avoir 4 formules par lignes. Je préfère faire le calcul en interne de la macro, et n'afficher que du texte dans les cellules)

 

[D4_]

Malgré tout, très bon fichier Titiak..
Feedback un peu fun.. (photo ci-joint)
La terre est ronde, c'est bien lol

 

[Lone-wolf]

Re D4

Désolé pour le quack, dû à l'oubli de End If dans la macro. Voici le code corrigé et d'après ton code.

Dim WsF As Worksheet, WsR As Worksheet
Dim plage As Range, cel As Range
Dim derlig As Long, lig As Long

Set WsF = Sheets("Feuil1"): Set WsR = Sheets("Routes")

        derlig = WsR.Range("a" & Rows.Count).End(xlUp)
        lig = WsR.Range("a" & Rows.Count).End(xlUp) + 1
        Set plage = WsR.Range("a2:a" & derlig)

With WsF
    If Not IsEmpty(.Range("a3")) <> "" And Not IsEmpty(.Range("b3")) _
       And Not IsEmpty(.Range("c2")) And Not IsEmpty(.Range("d2")) Then

        For Each cel In plage
            If cel Like "*REFERENCE*" Then
                cel.Offset(1, 0) = 1
            Else
                cel.Offset(1, 0) = WsR.Range("a" & lig)
            End If
               cel.Offset(1, 1) = .Range("a3")
               cel.Offset(1, 2) = .Range("b3")
               cel.Offset(1, 3) = .Range("c2")
              cel.Offset(1, 4) = .Range("d2")
              cel.Offset(1, 5) = .Range("h2")
              cel.Offset(1, 6) = .Range("j2")
        Next cel
    End If
End With

 

[Lone-wolf]

Bonsoir Pierre

Oué on se calme. Moi je n'ai fais que de me baser sur son code et le rendre un chuia plus propre. Et comme on est pas à ta hauteur, on fait avec les moyens du bord.

 

[Lone-wolf]

Re Pierre

Les lignes des textboxs sont en rouge, qu'est-ce tu fou???

Erreur dû à calcul(Me.TextBox1.value, Me.TextBox2.value). Ce ne serait pas mieux une fonction à la place de sub??

Et à notre ami, à la place des tooglebutton, je mettrais des commandbutton

Private Sub Annuler_Click()
Dim i As Long

For i = 1 To 14
Controls("TextBox" & i) = ""
Next i
End Sub

 

[Lone-wolf]

Re

Et pas besoin pour toutes les textbox, seulement de 8 à 14

Private Sub TextBox8_AfterUpdate()
If Me.TextBox1.value <> vbNullString And Me.TextBox8.value <> vbNullString Then
calcul Me.TextBox1.value, Me.TextBox8.value
End Sub

 

[GuiDUG]

Bonjour

Quand j'utilise les différents fichiers proposés ici, aucun calcul ne se fait.

Est-ce normal ?

 

[GuiDUG]

C'est bien ce que je craignais...

Sur les autres sites (VIA MICHELIN, MAPPY....). Y'a t-il moyen de récupérer les kilomètres et péage d'un trajet ?

Merci