Routeplannersheet; automatisch bijwerken (cel ophalen > daarna invoegen als waarde)

[Majelles]

Hallo,

Ik heb wat leuks bedacht en heb wat problemen in de uitvoering

Het is een sheet met een routeplanner (ANWB).
Nu zou het zo handig zijn dat er steeds een nieuwe postcode kan worden opgehaald, de sheet de tijd krijgt om de data op te halen (zijn vaak veel verschillende postcodes) en dan als waarde invoegen op een ander tabblad (zodat hij niet blijft rekenen).

Voor het gemak hier een link naar mijn bestand.
http://www.mijnbestand.nl/Bestand-XGIAKLZVBFP8.xlsx

Ik kon alleen of invoegen of als waarde plakken; niet allebei maar misschien is hier een VBA code voor.
En hoe kan ik Excel laten kijken naar de volgende cel...

Omdat het veel postcodes zijn duurt het soms wel even voor hij alles door is.
Een macro om een nieuwe postcode op te halen is ook een optie, die kan dan handmatig herhaald worden.

Is dit haalbaar?

 

[Majelles]

Ik heb het eerste stukje voor elkaar, heel basic maar het werkt ;-)
Ik kopieer de cellen, plak ze er even naast als waarde, knip ze dan en voeg ze in op een ander tabblad

Mocht iemand nog een idee hebben hoe ik een macro kan maken dat hij de eerst volgende postcode ophaalt om te gaan rekenen, heel graag :thumb:

 

[Warme bakkertje]

Public Declare Function timeGetTime Lib "winmm.dll" () As Long

Sub tst()
StartTime = timeGetTime
sn = Sheets("Rekensheet").Range("D2:D5")
sn2 = Sheets("Gegevens").Range("B2:B23")
j = 1
ReDim result(1 To UBound(sn) * UBound(sn2), 1 To 3)
    For i = 1 To UBound(sn2)
        For ii = 1 To UBound(sn)
            result(j, 1) = sn(ii, 1)
            result(j, 2) = sn2(i, 1)
            result(j, 3) = afstand(sn(ii, 1), sn2(i, 1), "Fast")
            j = j + 1
        Next
    Next
Sheets("Uitkomsten").Range("A2").Resize(UBound(sn) * UBound(sn2), 3) = result
  EndTime = timeGetTime
  MsgBox (EndTime - StartTime) / 1000 & " seconds"
End Sub

Ik heb nu wel alle bereiken hard gecodeerd zoals in je voorbeeld, deze kunnen uiteraard variabel gemaakt worden.
Voor deze 88 resultaten kwam ik op 15.9 sec. berekeningstijd.
Er zaten wel een hoop niet bestaande postcodes tussen ?

 

[Majelles]

Warm bakkertje, dank je wel voor je hulp. Zo te zien is dat inderdaad wat ik zoek
Ik had je code erin geplakt maar helaas deed hij toen niets meer (ik zal het wel verkeerd gedaan hebben).
Zou je mee willen kijken waar ik je code kan neerzetten?

Ik heb het bestand aangepast:
http://www.mijnbestand.nl/Bestand-QU3YB3YDNSHL.xlsm

 

[Warme bakkertje]

Ik heb je bestand aangepast. De macro wordt gestart door op ctrl+i te drukken.
Voor het aantal postcodes die er nu instaan kwam ik uit op 150 sec. Als je dus het aantal postcodes op Rekensheet gaat uitbreiden moet je wel rekenig houden met een langere verwerkingstijd.

 

[Majelles]

Warm bakkertje, je bent geweldig!! :d :d

Ik durf het bijna niet te vragen.. is het ook mogelijk de weggeschreven kolommen naast elkaar te plaatsen ipv onder elkaar?

Het zal hiermee te maken hebben maar ik weet niet hoe ik dit kan aanpassen:
Sheets("Uitkomsten").Range("A2").Resize(UBound(sn) * UBound(sn2), 3) = result
EndTime = timeGetTime

 

[Warme bakkertje]

Plaats eens een voorbeeldje van hoe jij de resultaten wil zien.

 

[Majelles]

Excuses dat ik het niet gelijk duidelijk heb gemaakt, voor mij is het zo vanzelfsprekend dat ik er niet bij stil heb gestaan dat het ook anders weggezet kan worden

Hierbij het voorbeeldbestand:
http://www.mijnbestand.nl/Bestand-GXYH6HLAQMKR.xlsm

 

[Warme bakkertje]

Probeer het dan eens met deze.

Sub tst()
    StartTime = timeGetTime
    sn = Sheets("Rekensheet").Range("C2:C" & Sheets("Rekensheet").Cells(Rows.Count, 3).End(xlUp).Row)
    sn2 = Sheets("Vestigingen").Range("C2:C" & Sheets("Vestigingen").Cells(Rows.Count, 3).End(xlUp).Row)
    j = 1
    ReDim result(1 To UBound(sn), 1 To UBound(sn2) * 3)
    For i = 1 To UBound(sn2)
        result(1, j) = sn2(i, 1)
        For ii = 1 To UBound(sn)
            result(ii, j + 1) = afstand(sn(ii, 1), sn2(i, 1), "Fast")
            result(ii, j + 2) = IIf(result(ii, j + 1) < 65, "gehouden", "niet gehouden")
        Next
        j = j + 3
    Next
    With Sheets("Uitkomsten")
        .Range("A2").Resize(UBound(sn), UBound(sn2) * 3) = result
        .UsedRange.Columns.AutoFit
    End With
    EndTime = timeGetTime
    MsgBox (EndTime - StartTime) / 1000 & " seconds"
End Sub

 

[Majelles]

Warm Bakkertje, ik heb hem getest; ja dat had ik in mijn hoofd met het wegschrijven van de uitkomsten!!

Alleen gaat hij niet niet meer vanzelf naar de volgende postcode; ben aan het klooien geweest om het zelf op te lossen maar het is mij niet gelukt

Mag ik nog een beroep op je doen?

 

[Warme bakkertje]

Getest op jouw laatste voorbeeldbestand.
Zie bijlage voor resultaat.

 

[Majelles]

Warm Bakkertje, Super! Heel erg bedankt voor je hulp :thumb:

Een virtueel bloemetje voor je (die ik helaas niet geplakt krijg..)
het is een mooi bos