adressen samenvoegen

[deheugden]

is het mogelijk om adressen samen te voegen die overeenkomen waarbij het dubbele wegvalt?
dus, zoals bijv. in het voorbeeld:

klaasje
straat1
stad

henkje
straat2
stad

pietje
straat1
stad

kareltje
straat1
stad

wordt dan:

klaasje
pietje
kareltje
straat1
stad

ik vind wel info over adressen ontdubbelen maar dit is toch iets heel anders . De optie duplicaten verwijderen haalt namelijk ook postcodes en stad weg
alvast bedankt voor een reactie.

 

[HSV]

Maak je bestand zo goed mogelijk na.
Ik neem aan dat er andere gegevens in staan dan overal 'stad'.
Straks heeft er iemand een oplossing en is het weer niet goed omdat je andere gegevens hebt in je origineel.

 

[deheugden]

edit, heb dit gevonden:
http://userbase.be/forum/viewtopic.php?f=8&t=28411&p=363069#p363069
eens kijken of ik daar wijs uit word aangezien dat er ook interessant uitziet.
ps, mag ik linken naar een andere site?

 

[deheugden]

Maak je bestand zo goed mogelijk na.
Ik neem aan dat er andere gegevens in staan dan overal 'stad'.
Straks heeft er iemand een oplossing en is het weer niet goed omdat je andere gegevens hebt in je origineel.

Dank voor de reactie. De stad is momenteel steeds hetzelfde maar het kan zijn dat deze naar de toekomst toe gaat veranderen. Ik doe een stukje vrijwilligers werk en we gaan bedelbrieven versturen. Momenteel gaan we organisaties in de stad benaderen.

 

[HSV]

Laat deze macro eens lopen.

Sub hsv()
Dim y As Long, irow As Long, i As Long, sq As String, sn As Variant, sq1 As String
 y = 4
 With Sheets("Blad1")
For irow = 2 To .Cells(Rows.Count, 1).End(xlUp).Row Step 4
 If InStr(1, sq1, .Cells(irow + 1, 1)) > 0 Then
   Else
 For i = 3 To .Cells(Rows.Count, 1).End(xlUp).Row Step 4
   If .Cells(i, 1) = .Cells(irow + 1, 1) Then
 sq1 = sq1 & .Cells(irow + 1, 1)
sq = sq & "|" & .Cells(i - 1, 1)
   End If
  Next i
 sn = Split(sq, "|")
    .Cells(1, y).Resize(UBound(sn)) = Application.Transpose(Split(Mid(sq, 2), "|"))
    .Cells(1, y).Offset(UBound(sn)) = .Cells(irow + 1, 1)
    .Cells(1, y).Offset(UBound(sn) + 1) = .Cells(irow + 2, 1)
       y = y + 1
     sq = ""
   End If
  Next irow
 End With
End Sub

 

[deheugden]

alles is nu zoals ik het hebben wil.
Bedankt voor de hulp.