Vraagje Samenvoegen

[NajKwin]

Hallo,

Ik heb ooit hier eens een vraag gesteld over het samenvoegen van namen die op het zelfde adres wonen.
Hier ben ik prima mee geholpen echter ik had nog graag een aanpassing gezien en de vraag is wie kan me daar bij helpen.

Nu is het zo dat de samengevoegde namen bij het adres komen te staan. in kolom D en E

Nu zou ik graag een wijziging willen dat aan de hand van het adres ook de desbetreffende achternaam getoond wordt en dan zou het mooist zijn dat in Kolom D de namen verschijnen in Kolom E de Achternaam en in Kolom F het adres.



b.v.d

Naj

 

[OctaFish]

Dat zou dan zo kunnen:

Sub Knop1_Klikken()
    Range("D2:F30").ClearContents                                                   'maak samenvatting leeg
    For Each cell In Range(Range("c2"), Range("c2").End(xlDown))                    'bepaal het zoekbereik
        x = cell.Value                                                              'bepaal de zoekwaarde
        Set y = Range("F2:F21").Find(x, LookIn:=xlValues)                           'zoek die waarde
        If Not y Is Nothing Then                                                    'als de waarde gevonden is in de samenvatting
            y.Offset(, -2) = y.Offset(, -2).Value & " - " & cell.Offset(, -2).Value 'plaats er dan de nieuwe naam bij
        Else                                                                        'anders
            With Range("F30").End(xlUp)                                             'zoek de laatste gevulde regel in de samenvatting
                .Offset(1) = x                                                      'plaats dezoekwaarde op de volgende regel
                .Offset(1, -1) = cell.Offset(, -1).Value                            'plaats de naam in de vorige kolom
                .Offset(1, -2) = cell.Offset(, -2).Value                            'plaats de naam in de vorige kolom
            End With
        End If
    Next                                                                            'ga naar de volgende zoekwaarde
    Columns("D:F").Columns.AutoFit                                                  'maak de kolommen van de samenvatting op de juiste breedte
End Sub

 

[NajKwin]

Super

Dank je Octafish

 

[OctaFish]

Heel flexibel is jouw code overigens niet; met deze variant ben je niet afhankelijk van vaste rijen.

Sub Knop1_Klikken()
Dim iR As Integer
    Range(Cells(2, 4), Cells(Cells(, 6).End(xlDown).Row, 6)).ClearContents         'maak samenvatting leeg
    iR = 1
    For Each cell In Range(Range("C2"), Range("C2").End(xlDown))                    'bepaal het zoekbereik
        iR = iR + 1
        x = cell.Value                                                              'bepaal de zoekwaarde
        Set y = Range(Cells(2, 6), Cells(1 + iR, 6)).Find(x, LookIn:=xlValues)                        'zoek die waarde
        If Not y Is Nothing Then                                                    'als de waarde gevonden is in de samenvatting
            y.Offset(, -2) = y.Offset(, -2).Value & ", " & cell.Offset(, -2).Value 'plaats er dan de nieuwe naam bij
        Else                                                                        'anders
            With Range("F30").End(xlUp)                                             'zoek de laatste gevulde regel in de samenvatting
                .Offset(1) = x                                                      'plaats dezoekwaarde op de volgende regel
                .Offset(1, -1) = cell.Offset(, -1).Value                            'plaats de naam in de vorige kolom
                .Offset(1, -2) = cell.Offset(, -2).Value                            'plaats de naam in de vorige kolom
            End With
        End If
    Next                                                                            'ga naar de volgende zoekwaarde
    Columns("D:F").Columns.AutoFit                                                  'maak de kolommen van de samenvatting op de juiste breedte
End Sub

Kun je meer mensen toevoegen .