adressenlijsten samenvatten

[dixieyup]

Goedemiddag,

Ik werk bij een woningcorporatie. We hebben een excelbestand met alle adressen van het woningbestand (complex, plaats, straatnaam, huisnummer etc.). Dit willen we eigenlijk per straat groeperen, aangezien het een superlange lijst is. Ik heb door middel van een draaitabel een opzet gemaakt met allereerst alles per plaats gegroepeerd, dan per straat en dan per huisnummer. Ik kan ook het aantal woningen in een totaal samenvatten. Het probleem is nu dat alle huisnummers onder elkaar blijven staan waardoor de lijst toch nog even lang blijft. Ik wil eigenlijk alle huisnummers naast elkaar in een tabel zodat de lengte van het bestand korter wordt.

Hoe kan ik zo'n bestand samenstellen? Ik gebruik excel redelijk vaak, dus ik kan wel het een en ander voor elkaar krijgen, maar macro's gaat me te ver. Maar ja, alles kun je leren. Kunnen jullie mij helpen? Ik heb een bestandje als voorbeeld toegevoegd.

Alvast bedankt,

Marleen

 

[Wigi]

Marleen

Je zal met VBA moeten werken, en een simpele loop in mekaar klutsen. Wat is je kennis van VBA nu en je bereidheid om je er wat in te verdiepen?

In de VBA help files staat er uitgewerkte code voor de analoog van Bewerken > Zoeken in Excel.

Sorteer eerst je gegevens, dan doe je een Loop met een zoekfunctie ingebouwd.

Als het je niet lukt probeer ik straks nog de code in mekaar te steken.

Wigi

 

[Wigi]

Als het je niet lukt probeer ik straks nog de code in mekaar te steken.

Je kan je de moeite besparen, heb het zelf gedaan.

Sub AdressenSamenvatten()

Dim c As Range, d As Range, rngToDo As Range
Application.ScreenUpdating = False
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), Order2:=xlAscending, _
    Key3:=Range("C1"), Order3:=xlAscending, Header:=xlNo, OrderCustom:=1, Orientation:=xlTopToBottom
    
    Set rngToDo = Range("B1", Range("B" & Rows.Count).End(xlUp))
    
    For Each c In rngToDo
        If c <> "" Then
        
            Set d = rngToDo.Find(c, After:=c, LookIn:=xlValues, lookat:=xlWhole)
            If Not d Is Nothing Then
                Do
                    c.Offset(, 1) = c.Offset(, 1) & ", " & d.Offset(, 1)
                    d.Offset(, -1).Resize(, 3).ClearContents
                    Set d = rngToDo.FindNext(d)
                Loop While Not d Is Nothing And d.Address <> c.Address
            End If
        End If
    Next
Range("A1:C" & Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), _
    Order2:=xlAscending, Key3:=Range("C1"), Order3:=xlAscending, Header:=xlNo, OrderCustom:=1, Orientation:=xlTopToBottom
Range("A1:C1").EntireColumn.AutoFit
Application.ScreenUpdating = True
End Sub

Zet de gemeente / stad in kolom A, de straatnaam in kolom B en de nummer in kolom C. Laat dan de code erop los.

Wigi

 

[Wigi]

Marleen

Heb de totaalkolom er ook nog bijgedaan.

Sub AdressenSamenvatten()

Dim c As Range, d As Range, rngToDo As Range
Application.ScreenUpdating = False
Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), Order2:=xlAscending, _
    Key3:=Range("C1"), Order3:=xlAscending, Header:=xlNo, OrderCustom:=1, Orientation:=xlTopToBottom
    
    Set rngToDo = Range("B1", Range("B" & Rows.Count).End(xlUp))
    
    For Each c In rngToDo
        If c <> "" Then
        
            Set d = rngToDo.Find(c, After:=c, LookIn:=xlValues, lookat:=xlWhole)
            If Not d Is Nothing Then
                Do
                    c.Offset(, 1) = c.Offset(, 1) & ", " & d.Offset(, 1)
                    c.Offset(, 2) = c.Offset(, 2) + 1
                    d.Offset(, -1).Resize(, 4).ClearContents
                    Set d = rngToDo.FindNext(d)
                Loop While Not d Is Nothing And d.Address <> c.Address
            End If
        End If
    Next

With Range("E1")
    .Value = 1
    .Copy
    rngToDo.Offset(, 2).SpecialCells(xlCellTypeConstants).PasteSpecial Operation:=xlAdd
    .ClearContents
End With

Range("A1:D" & Range("A" & Rows.Count).End(xlUp).Row).Sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1"), _
    Order2:=xlAscending, Key3:=Range("C1"), Order3:=xlAscending, Header:=xlNo, OrderCustom:=1, Orientation:=xlTopToBottom
Range("A1:D1").EntireColumn.AutoFit
Range("A1").Select
Application.ScreenUpdating = True
End Sub

Wigi

 

[richard1970]

LOL
Hij kan het niet laten

 

[Wigi]

LOL
Hij kan het niet laten

Nee, het is sterker dan mezelf

Trouwens, Marleen, pas op als dezelfde straatnaam in meerdere gemeenten / steden voorkomt. Dan gaat het niet meer correct zijn.

Wigi

 

[dixieyup]

Snelle reacties

Zo zeg, dat is snel gedaan. Nu komen sommige straten meedere keren voor. Bijna elk dorp heeft wel een Dorpsstraat of Kerkstraat, dus ik ga nog even verder knutselen.

Alvast bedankt voor de snele reacties!

 

[dixieyup]

Andere oplossing?

Hallo,

Ik ben geen macrokenner en ik wil zoeken naar een gemakkelijke oplossing die ik ook nog snel aan collega's uit kan leggen. Op zich heb ik nu wel een oplossing in mijn hoofd, ik moet alleen nog een heeeel klein beetje geholpen worden.

Als ik nou achter de adressentabel een tabel maak waarop ik oplopende nummers zet (bij elk adres opnieuw startend met 1), dan kan ik gmakkelijk gebruik maken van een draaitabel. Ik kan dat allemaal wel handmatig doen, maar met een adressenbestand van een aantal duizend woningen zie ik dat niet zitten.

Er moet toch wel een gemakkelijke formule zijn die gekoppeld is aan het adres en er dan voor zorgt dat het telkens oploopt en bij een nieuw adres weer start met 1.

Ik heb via een ander forum deze oplossing gekregen, alleen werd het hier handmatig ingevuld (toch bedankt voor je hulp). ik heb dit als bijalge toegvoegd zodat jullie weten wat ik bedoel. Het betreft de gegevens in de gele tabel.

Weten jullie een formule hiervoor?

Bedankt!

 

[Wigi]

Ik heb via een ander forum deze oplossing gekregen, ...

Weten jullie een formule hiervoor?

Waarom vraag je de formule niet op het andere forum? Je post blijkbaar toch tegelijkertijd dezelfde vraag op meerdere forums... Weet dat dit absoluut slecht onthaald wordt als je zelfs nog niet de moeite neemt om een link te plaatsen naar je vraag op het andere forum. Je maakt helpers niet echt geneigd om nog in te zitten met jouw vraag.

Anyway, doe misschien:

=SOMPRODUCT(($A$2:$A$16=A2)*($D$2:$D$16<=D2))

Wigi

 

[dixieyup]

sorry

Sorry,

Ik ken denk ik de forum etiquette nog niet zo goed, ik heb er eigenlijk nog niet echt vaak gebruik van gemaakt. Daardoor leek het me verstandig de vraag op twee forums te zetten. De volgende keer denk ik er beter bij na.

Bedankt!

 

[Wigi]

Sorry,

Ik ken denk ik de forum etiquette nog niet zo goed, ik heb er eigenlijk nog niet echt vaak gebruik van gemaakt. Daardoor leek het me verstandig de vraag op twee forums te zetten. De volgende keer denk ik er beter bij na.

Bedankt!

Zo is het beter...

En werkt het nu?

 

[dixieyup]

dat is snel

Zo dat is snel ,

Ik heb even gekeken, maar het lukt me niet. Wanneer ik de formule in de cel naast de gegevens kopieer, dan komen er nullen te staan. Ik ben volgens mij een excelanalfabeet. op zich kan ik er mijn weg goed in vinden, maar het lukt me nu gewoon niet. Ik zal even een gedeelte van het excelbestand toevoegen met in een geel de waarden die ik eigenlijk wil genereren.

Alvast bedankt voor je snelle reactie.

Groet, Marleen

 

[Wigi]

Zie bijlage Marleen.

Wigi

 

[dixieyup]

gedeeltelijk gelukt

Goedemiddag,

Met de formules is het gelukt. Hierdoor kreeg ik ook de gewenste draaitabel. Want wat ik eigenlijk wilde bereiken is dat ik van een totaal woningbestand een samenvatting kan maken, zodat de huisnummers per complex per straat erachter staan. Maar mijn ideetje kon dus niet goed toegepast worden aangezien er natuurlijk ook huisnummers zijn zoals 12b, 12-2 e.d. Aangezien ik hier geen nummers van kan maken gaat eht hier dus fout in de tabel. Ik heb als bijlage de opzet toegevoegd waar ik eigenlijk heel blij mee was, totdat ik uiteindelijk erachter kwam dat er dus nog kleine foutjes in zaten.

Heel erg bedankt voor je hulp, ik ga nu eens bedenken hoe ik het nog meer kan doen. Het moet gemakkelijker kunnen. Als ik de oplossing heb laat ik het wel even weten.

Groet, Marleen