Verplaatsing tussenvoegsels in namenlijst

[Sucas]

Weet iemand hoe ik in een namenlijst de tussenvoegsels kan verwijderen of verplaatsen naar een andere kolom, zodat ik de daadwerkelijke achternamen op alfabet kan zetten?

Voorbeeldlijst:
Janssen
van de Grient
ten Thije-Groeneveld
van den Akker
Akkermans
de Moor-van Kampen
van der Haven
van Oort

Helaas staan alle namen op deze wijze in 1 kolom. Alfabetiseren is onmogelijk omdat er alleen naar de eerste letter wordt gekeken en 'van de Grient' dus onder de 'v' wordt gezet en 'de Moor' onder de 'd', terwijl die respectievelijk onder de G en onder de M horen te staan.
Het gaat er dus om dat ik de eerstgenoemde achternaam op alfabet kan zetten, dus niet de meisjesnamen die na het koppelteken staan.
Is er bijvoorbeeld een optie om alles tot aan de eerste hoofdletter te wissen of te verplaatsen?
Ik werk overigens met Office Home and Office 2010, NL.

Ik heb me al suf zitten zoeken. Hopelijk kan iemand mij helpen.
Alvast bedankt voor het meedenken.

 

[rebmog]

Dat kan bijvoorbeeld met deze matrixformule (ingeven met Ctrl+Shift+Enter), die gebaseerd is op de positie van de eerste hoofdletter:

=DEEL(A1;MIN(ALS((CODE(DEEL(A1;RIJ(INDIRECT("1:"&LENGTE(A1)));1))>=65)*(CODE(DEEL(A1;RIJ(INDIRECT("1:"&LENGTE(A1)));1))<=90);RIJ(INDIRECT("1:"&LENGTE(A1)))));1000)

 

[HSV]

Of een macrootje.

Option Explicit
Sub splitten()
Dim Regex As Object, Rng As Range, i As Long, ObjM, ObjMatch, sn, ii As Long, k As Long
  Set Regex = CreateObject("VBscript.Regexp")
    Set Rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
     ReDim out(1 To Rng.Cells.Count)
 
    With Regex
        .Global = True
        .Pattern = "(?=[A-ZÄÖÜ])"
        For i = 1 To Rng.Cells.Count
          sn = .Replace(Rng(i, 1), ";")
            Set ObjMatch = .Execute(Rng(i, 1))
        For Each ObjM In ObjMatch
            If k = 0 Then
               out(i) = Replace(Mid(sn, ObjM.firstindex + 2), ";", "")
                k = k + 1
               End If
            Next
            k = 0
         Next
        Rng.Offset(, 1) = Application.Transpose(out)
    End With
    Rng.Resize(, 2).Sort Range("B1")
  Set Regex = Nothing
  Set Rng = Nothing
 End Sub

 

[Sucas]

Tjonge, daar moet ik even op gaan studeren, want voor mij is dat hogere wiskunde wat betreft Excel. Zulke ingewikkelde formules heb ik nog nooit mee gewerkt, laat staan bedacht.
Rebmog en Harry, bedankt in ieder geval voor het meedenken.

 

[Sucas]

Harry,
Jouw 'macrootje' - hoezo, tje? - werkt! Niet alleen de tussenvoegsels zijn weg, maar alles staat gelijk in alfabetische volgorde.
Dat laatste hoeft eigenlijk niet, want de rest van de rij wordt niet meegenomen en dat is wel de bedoeling (adres, telefoonnummer, e.d.)
Brutale vraag van mijn kant: is de macro zodanig aan te passen dat alleen de tussenvoegsels verdwijnen? Dan kan ik daarna weer doen met de lijst wat ik zelf wil.
Ik probeer die macro zelf te doorgronden zodat ik weet wat ik kan verwijderen, maar dat gaat me echt boven m'n pet.
De ledenadministratie van onze protestantse kerk zal je eeuwig dankbaar zijn.

 

[Sucas]

Rebmog,
Ik heb ook jouw oplossing geprobeerd, maar als ik bijvoorbeeld 'van Brenk' in cel A1 zet en jouw formule in A2, dan krijg ik de melding #WAARDE! in A2.
Zet ik eerst jouw formule in A2, vervolgens 'van Brenk' in A1 en druk dan op Ctrl+Shift+Enter, dan gebeurt er precies hetzelfde.
Ik ga ervan uit dat jouw formule klopt en dat ik iets verkeerd doe, maar wat?
Graag jouw advies, want ik zou graag snappen wat die formule inhoudt en hoe ik daarmee om moet gaan.

 

[HSV]

Het laatste stukje van de code.
Wel op een kopie uitvoeren, de gegevens verdwijnen voorgoed.

Next
            k = 0
         Next
        Rng = Application.Transpose(out)
    End With
  Set Regex = Nothing
  Set Rng = Nothing
 End Sub

Heb ik maar mooi referenties als het werkt, en kom ik nog eens ergens.

 

[rebmog]

Graag jouw advies, want ik zou graag snappen wat die formule inhoudt en hoe ik daarmee om moet gaan.

Wat ik uit je reactie opmaak is dat je cel A1 hebt afgesloten met Ctrl+Shift+Enter. Dat is niet goed, want je moet de formule afsluiten met Ctrl+Shift+Enter. Als je dat gedaan hebt, dan plaatst Excel automatisch accolades om deze formule. Dit is een teken dat het om een matrixformule gaat. Deze accolades moeten dus niet ingetypt worden. Vervolgens kun je deze matrixformule gewoon naar andere cellen kopiëren. Dit gaat op exact dezelfde manier als met het kopiëren van gewone formules.

 

[Warme bakkertje]

Of volledig in het werkgeheugen uitvoeren en dan resultaat wegschrijven (handig bij langere ledenlijsten)

Option Explicit
Sub splitten()

    Dim sq, i As Long, sn, ObjMatch, ObjM, k As Long
    sq = Sheets("Blad1").Cells(1).CurrentRegion.Resize(, 1)
    With CreateObject("VBscript.Regexp")
        .Global = True
        .Pattern = "(?=[A-ZÄÖÜ])"
        For i = 1 To UBound(sq)
            sn = .Replace(sq(i, 1), ";")
            Set ObjMatch = .Execute(sq(i, 1))
            For Each ObjM In ObjMatch
                If k = 0 Then
                    sq(i, 1) = Replace(Mid(sn, ObjM.firstindex + 2), ";", ""): k = k + 1
                End If
            Next
            k = 0
        Next
        Sheets("Blad1").Range("A1").Resize(UBound(sq)) = sq
    End With
    
End Sub

 

[Sucas]

Rebmog,
Het is gelukt! De formule werkt en ik begin te begrijpen hoe dat werkt met matrixformules. Ook de inhoud begint me enigszins te dagen.
Enorm bedankt. Een dergelijke opzet kan ik wellicht nog eens vaker gebruiken.

Harry,
Het was even puzzelen wat ik precies weg moest halen in de vorige macro, maar ook dat is gelukt. Die macro werkt nu prima.
Geweldig dat je nog net het laatste schepje er bovenop wilde doen.

Warme Bakkertje,
Ik heb je suggestie geprobeerd, maar het lukte me niet. Daar moet ik nog even verder op studeren.
Maar ja, ik heb nu 2 goede oplossingen dus ik kan in ieder geval verder. Jij ook bedankt voor je bijdrage.

Ik heb enorm veel geleerd van jullie allemaal. Excel was al leuk om mee te stoeien, maar het wordt alleen maar leuker zo!

Bedankt,
Susanne.

 

[Warme bakkertje]

Meest waarschijnlijk moet je de bladnaam in Sheets("Blad1") aanpassen naar de correcte bladnaam.

 

[Sucas]

Warme bakkertje,
Je hebt helemaal gelijk. Met die aanpassing werkt jouw oplossing ook. Dom dat ik daar zelf niet aan gedacht heb.
Zo zie je maar, elke dag worden we weer een stukje wijzer. Ik tenminste wel (laat ik even alleen voor mezelf spreken).
Alle leermeesters: nogmaals bedankt!

Susanne.

 

[HSV]

Of volledig in het werkgeheugen uitvoeren en dan resultaat wegschrijven (handig bij langere ledenlijsten)

Gebeurd in mijn code toch evenzo @Rudi ?