• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

postcode afstand berekenen

Status
Niet open voor verdere reacties.

tom300

Gebruiker
Lid geworden
6 feb 2008
Berichten
44
Hallo Allemaal,

Onderstaande macro zorgt voor een berekening van de afstand tussen twee postcodes:

Code:
Public Function GetPage(sLink As String) As XMLHTTP40
    Dim oObj As MSXML2.XMLHTTP40
    Set oObj = New XMLHTTP40
    oObj.Open "GET", sLink, False
    oObj.send ""
    Set GetPage = oObj
End Function

Public Function GetDistanceBetweenAreaCodes(Code1 As String, Code2 As String)
    Dim oResult As XMLHTTP40
    Dim oDOM As DOMDocument40
    Dim sStr As String
    Dim sResult As String
    Dim sURL As String
    Const sKeyWords As String = "</strong> route over <strong>"
    sURL = "http://route.anwb.nl/routeplanner/servlet/rp?action=0&zip1="
    sURL = sURL & Code1 & "&city1=&street1=&zip2="
    sURL = sURL & Code2 & "&city2=&street2=&iad=homepage.navigatie.middenkolom.routeplannerplanroute"
    Set oResult = GetPage(sURL)
    Set oDOM = New DOMDocument40
    sStr = oResult.responseText
    sResult = Mid(sStr, InStr(sStr, sKeyWords) + Len(sKeyWords))
    sResult = Replace(Mid(sResult, 1, InStr(sResult, " ")), ",", ".")
    GetDistanceBetweenAreaCodes = Val(sResult)
End Function

Deze code komt uit een eerder gestelde vraag:
http://www.helpmij.nl/forum/showthr...nd-berekenen?highlight=kortste+afstand+in+cel


Mijn vraag is de volgende.
Deze code gaat uit van de "snelste" route. Is er ook een manier om de "kortste" route te nemen binnen de macro?


Thanks again!!!


Gr, Tom
 
Laatst bewerkt:
volgens de URL wordt de kortste route gevraagd.

Als je de url in een browser plakt, zie je halverwege een radio button "snelste" en "kortste". Standaard staat ie op "snelste" en ik vraag me dus af hoe ik binnen bovenstaande code de radio button "kortste" kan triggeren.

Ik had zelf .kortste geplakt in regel 10 van het tweede deel van de macro maar dat werkte niet. Dat heb ik er dus weer vanaf gehaald.

tnx!
 
Laatst bewerkt:
Je zou dit achter de URL moeten plakken:

&planmode=Fast

of

&planmode=Short
 
Ik heb de url ff geknipt en geplakt:
Code:
http://route.anwb.nl/routeplanner/?action=9[COLOR="#0000FF"]&loc1=[/COLOR]^499752.0^6767472.0^Beukenlaan^44^4793BN^Fijnaart^Moerdijk^528^^^[COLOR="#0000FF"]&loc2=[/COLOR]^514463.0^6769104.0^Rollaaf^11^4761
HR^Zevenbergen^Moerdijk^528^^^[COLOR="#0000FF"]&over_country=[/COLOR]-1[COLOR="#0000FF"]&over_location=[/COLOR];0.0;0.0;0[COLOR="#FF0000"]&planmode=Fast[/COLOR]
 
Laatst bewerkt:
Ik gebruik deze:
' Microsoft WinHTTPservices, version5.1

Code:
Sub tst()
  msgbox  afstand("1071NJ", "4761RA") & "km"
End Sub

Public Function afstand(pc1, pc2)
  With New WinHttpRequest
    .Open "GET", "http://route.anwb.nl/routeplanner/servlet/rp?zip1='" & pc1 & "'&zip2='" & pc2 & "'", True
    .send
    afstand = Replace(Join(Filter(Split(Split(.responseText, "km")(0) & "~", ">"), "~"), ""), "~", "")
    .abort
  End With
End Function
 
Laatst bewerkt:
Ik gebruik deze:
' Microsoft WinHTTPservices, version5.1

Code:
Sub tst()
  msgbox  afstand("1071NJ", "4761RA") & "km"
End Sub

Public Function afstand(pc1, pc2)
  With New WinHttpRequest
    .Open "GET", "http://route.anwb.nl/routeplanner/servlet/rp?zip1='" & pc1 & "'&zip2='" & pc2 & "'", True
    .send
    afstand = Replace(Join(Filter(Split(Split(.responseText, "km")(0) & "~", ">"), "~"), ""), "~", "")
    .abort
  End With
End Function


Hoi SNB,

Bedankt voor je bijdrage. Je zou me enorm helpen met een excel voorbeeld van hoe de "voorkant" er uit moet zien mbt jouw code.

Thanks!


Gr
 
Ik heb de url ff geknipt en geplakt:
Code:
http://route.anwb.nl/routeplanner/?action=9[COLOR="#0000FF"]&loc1=[/COLOR]^499752.0^6767472.0^Beukenlaan^44^4793BN^Fijnaart^Moerdijk^528^^^[COLOR="#0000FF"]&loc2=[/COLOR]^514463.0^6769104.0^Rollaaf^11^4761
HR^Zevenbergen^Moerdijk^528^^^[COLOR="#0000FF"]&over_country=[/COLOR]-1[COLOR="#0000FF"]&over_location=[/COLOR];0.0;0.0;0[COLOR="#FF0000"]&planmode=Fast[/COLOR]

Hoi Piet,

Ik heb elke mogelijkheid geprobeerd om het stukje code &planmode=Fast op een plek in de macro te plaatsen waardoor hij het gewenste resultaat geeft, echter wil dit maar niet lukken. Heb jij een suggestie waar ik het stukje code binnen bovenstaande macro kan plaatsen?

Alvast bedankt!


Gr
 
Ik heb het ff uitgewerkt.
zie bijlage.....

Hi Piet,

Bedankt voor je bijdrage. Ik krijg echter een foutmelding in VBA, zie bijlage.fout.PNG

War ik eigenlijk heen wil is een heel simpel excelblad dat de kortste route berekend ipv de snelste. In bijgevoegd excelvoorbeeld zie je wat ik bedoel. In dit voorbeeld rekent hij standaard de snelste route uit maar dat moet de de kortste worden. Ik heb het gevoel dat de oplossing vrij makkelijk is dor het toevoegen van het eerder genoemde stukje code maar ik kom er alleen niet achter waar het moet komen te staan. Bekijk bijlage Afstand-Tussen-Postcodes.xlsm

Heb jij een idee?

Thanks again!

Gr
 
Code:
Function afstand(pc1, pc2, opt)
  txt = "http://route.anwb.nl/routeplanner/servlet/rp?zip1='" & pc1 & "'&zip2='" & pc2 & "'&planmode=" & opt
  With New MSXML2.XMLHTTP
    .Open "GET", txt, True
    .send
    [COLOR="#FF0000"]Do
        DoEvents
    Loop Until .readyState = 4[/COLOR]
    x = InStr(1, .responseText, "Totaal (tijden afgerond op hele minuten):", vbTextCompare)
    y = InStr(1, Mid(.responseText, x + 61, 100), " km", vbTextCompare)
    afstand = CDbl(Mid(.responseText, x + 61, y - 1))
    .abort
  End With
End Function

Of deze
Code:
Public Function afstand(pc1, pc2, opt)
'Bij verwijzingen 'Microsoft WinHTTP Services,version 5.1' aanvinken
  With New WinHttpRequest
    .Open "GET", "http://route.anwb.nl/routeplanner/servlet/rp?zip1='" & pc1 & "'&zip2='" & pc2 & "'&planmode=" & opt, True
    .send
    .waitForResponse (3)
    afstand = Replace(Join(Filter(Split(Split(.responseText, "km")(0) & "~", ">"), "~"), ""), "~", "")
    .abort
  End With
End Function
 
Laatst bewerkt:
Hi Piet,

Bedankt voor je bijdrage. Ik krijg echter een foutmelding in VBA, zie bijlage.Bekijk bijlage 152473

War ik eigenlijk heen wil is een heel simpel excelblad dat de kortste route berekend ipv de snelste. In bijgevoegd excelvoorbeeld zie je wat ik bedoel. In dit voorbeeld rekent hij standaard de snelste route uit maar dat moet de de kortste worden. Ik heb het gevoel dat de oplossing vrij makkelijk is dor het toevoegen van het eerder genoemde stukje code maar ik kom er alleen niet achter waar het moet komen te staan. Bekijk bijlage 152475

Heb jij een idee?

Thanks again!

Gr

Ja zo moet je hem aanpassen:

Code:
sURL = sURL & Code2 & "[COLOR="#FF0000"]&planmode=Short[/COLOR]&city2=&street2=&iad=homepage.navigatie.middenkolom.routeplannerplanroute"
 
Ja zo moet je hem aanpassen:

Code:
sURL = sURL & Code2 & "[COLOR="#FF0000"]&planmode=Short[/COLOR]&city2=&street2=&iad=homepage.navigatie.middenkolom.routeplannerplanroute"

Hi Piet,

Ik had al van alles geprobeerd, maar die nog niet :-)

Super bedankt, dit werkt perfect!


@ iedereen: Bedankt voor het meedenken!
 
Ik zou deze macro graag willen gebruiken om voor een reeks (100 regels) de afstand tussen 2 postcodes te bepalen. Kan iemand mij vertellen hoe ik deze macro daarvoor kan aanpassen?? Alvast hartelijk dank!
 
Hallo Allemaal,

Ik heb dit project weer terug opgepakt en loop toch nog tegen een probleem aan.
Bijgevoegd het excelbestand waar jullie mij initieel super mee geholpen hebben.
Op de een of andere manier krijg ik steeds een #WAARDE foutmelding bij de berekening van de afstand, terwijl de macro's hetzelfde zijn als in het initiele bestand.

Heeft iemand enig idee wat er hier mis gaat?

Thanks a lot!!!


Gr, Tom

Bekijk bijlage Afstand-Tussen-Postcodes2.xlsm
excel.png
 
Laatst bewerkt:
#Waarde komt doordat ANWB u vraagt een keuze te maken

Als je de twee postcodes invoert op de routeplanner van de ANWB, dan merk je dat er vervolgscherm komt waar je een keuze moet maken voor een bepaalde straat. Ik heb hier ook last van in mijn Excelsheet.
Iemand een oplossing?
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan