Postcode reeks genereren

Op mijn huidige opdracht had een collega een bestand met een begin- en eind postcode (en daar dan heel veel van). Maar ze wilde ook graag de tussenliggende postcodes hebben. Ze vroeg me of ik een oplossing wist.

Mogelijk is er een slimmere oplossing, maar ik maakte een korte macro in Excel VBA. De macro werkt als volgt:

• de macro gaat uit van minimaal 2 tabbladen: BRON en DOEL. Op BRON staat in cel A2 de 1ste START postcode, in B2 de 1ste EIND postcode. A3 bevat de 2de START. En zo verder. Het aantal start/stop-postcodes maakt niet uit.
  
• zodra je de macro aanroept, positioneert de macro zichzelf op de goede tabbladen en cellen (je hoeft niet perse op tabblad BRON, DOEL of in cel A2 te staan)
  
• zie verder de documentatie in de code hieronder
  
• de huidige macro gaat er van uit dat het nummer-deel van de VAN en TOT-postcode altijd hetzelfde is. We kunnen dus bijvoorbeeld alle tussenliggende postcodes van 1234 AB t/m 1234 YL aanmaken, maar de onderstaande versie van de code kan niet omgaan met bv een VAN-waarde 1234 AB en een TOT waarde van 2345 YH.
  

Dus, als tabblad BRON het volgende bevat:

Cel A2: 1234 AG, cel B2: 1234 AL
Cel A3: 5462 DF, cel B3: 5462 TE
etc

Dan maakt de makro op tabblad DOEL een rij aan (startend in cel A2, dan A3 etc):

1234 AG
1234 AH
1234 AI
1234 AJ
1234 AK
1234 AL
5462 DF
5462 DG
5462 DH
(en zo door, t/m)
5462 TE


Hieronder de VBA-code:

Sub MaakPostcodeReeks()
'
' Test Macro
' Macro recorded 8/11/2010 by Raoul Teeuwen
'

' Definieer de variabelen
' pcvn bevat het numerieke deel van de postcode. Dus indien de postcode 1234 AB is, bevat pcvn 1234
Dim pcvn As String
' pcvl1 bevat de 1ste PostCode VanafLetter. Dus indien de postcode 1234 AB is, bevat pcvl1 de A
Dim pcvl1 As String
' pcvl2 bevat de 2de PostCode VanafLetter. Dus indien de postcode 1234 AB is, bevat pcvl2 de B
Dim pcvl2 As String
' pctl1 bevat de 1ste PostCode TotLetter. Dus indien de postcode 1234 XY is, bevat pctl1 de X
Dim pctl1 As String
' pctl2 bevat de 2de PostCode TotLetter. Dus indien de postcode 1234 XY is, bevat pctl1 de Y
Dim pctl2 As String

' Leegteller gebruiken we om te tellen hoeveel lege regels we achter elkaar tegenkomen: als we 10 lege regels achter elkaar hebben, gaan we er van uit dat we alle postcodes hebben behandeld
Dim leegteller As Integer

leegteller = 0


'ga naar het resultatensheet, en ga linksboven (a2) staan
Sheets("Doel").Select
Cells.Select
Range("A2").Activate
'maak het DOEL_tabblad leeg
Selection.ClearContents
Range("A2").Select

'we gaan er van uit dat de van/tot postcodes in een tabblad Bron staan, vanaf cel A2. Dus A2 bevat de 1ste van-postcode, cel b2 de 1ste t/m postcode
'ga naar het sheet met op te halen waardes, en ga linksboven (a2) staan
Sheets("Bron").Select
'in D12 zetten we een tekst als we klaar zijn > die maken we nu dus 1st leeg
Range("D12").Select
Selection.ClearContents
Range("A2").Select

'vanaf hier moeten we gaan loopen
Do

'    Selection.Copy
pcvn = Left(ActiveCell, 4)
pcvl2 = Right(ActiveCell, 1)
pcvl1 = Left(Right(ActiveCell, 2), 1)

' beweeg de cursor 1 positie naar rechts
ActiveCell.Offset(rowOffset:=0, columnOffset:=1).Activate
'    Selection.Copy
pctl2 = Right(ActiveCell, 1)
pctl1 = Left(Right(ActiveCell, 2), 1)

'kopieer de waarde naar het DOEL werkblad, linksboven (a2)
Sheets("Doel").Select
ActiveCell.Offset(rowOffset:=0, columnOffset:=0).Activate

Do

'1ste loop

Do
'2de loop
ActiveCell.FormulaR1C1 = pcvn & " " & pcvl1 & pcvl2
'naar volgende cel gaan
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
'volgende letter: dus als we 1234 AB hebben, is de 2de letter een B, daarna C, D etc.
pcvl2 = Chr(Asc(pcvl2) + 1)
Loop Until pcvl2 > "Z" Or (pcvl1 = pctl1 And pcvl2 > pctl2)
' we zijn klaar, of de 2de letter is t/m Z gekomen > dan moeten we vanaf A beginnen. Bv we zijn tot AZ gekomen, dan is de volgende BA
pcvl2 = "A"
' volgende letter: dus als we 1234 AZ hebben, is de 1ste letter een A, daarna B, C etc.
pcvl1 = Chr(Asc(pcvl1) + 1)
'we gaan door totdat we voorbij de TOT postcode zijn.
Loop Until Asc(pcvl1) > Asc(pctl1) Or (pcvl1 = pctl1 And pcvl2 > pctl2)


Sheets("Bron").Select
ActiveCell.Offset(rowOffset:=1, columnOffset:=-1).Activate

Do
If (ActiveCell) = "" Then
leegteller = leegteller + 1
ActiveCell.Offset(rowOffset:=1, columnOffset:=0).Activate
End If
Loop Until ActiveCell <> "" Or leegteller > 10

Loop Until leegteller > 10

'We zijn klaar: zet in D12 dat we klaar zijn
Range("D12").Select
ActiveCell.FormulaR1C1 = "Postcodereeks(en) zijn aangemaakt op tabblad DOEL."

End Sub

Echte VBA-profs zullen er vast nog onnodige coderegels in aantreffen, of optimalisaties weten. Maar het werkt mi al goed en snel. En wie weet heeft iemand anders er ook nog wat aan :-).