zinnen scheiden op basis van een compleet (!) woord

[keb]

Ik wil zinnen scheiden waarin het oud-Hollandse woord "genaemt" in voorkomt. De bestaande kolom wil ik splitsen in twee nieuwe kolommen.

VOORBEELD
"een weijde landts genaemt langhcamp" moet worden "een weijde landts genaemt " en "langhcamp".

De VBA-instructie InStr werkt niet omdat op de afzonderlijke letters "g", "e", "n", "a", "e", "m" en "t" wordt gezocht.

Wie weet een oplossing? Zie bijgeloten voorbeeld-bestand.

Sub Scheiden_titel()
'
' Scheiden_titel Macro
Dim intPos, intRow
Dim rngRange, cell As Range
Dim strZoek As String

strZoek = "genaemt"

Set rngRange = Range("A2:A15")

For Each cell In rngRange
    intPos = InStr(1, Cells(cell.Row, 1).Value, strZoek, 1)
    Cells(cell.Row, 2) = Left(Cells(cell.Row, 1).Value, intPos)
    Cells(cell.Row, 3) = Right(Cells(cell.Row, 1).Value, intPos)
    Next

End Sub

 

[SjonR]

Er wordt niet op afzonderlijke letters gezocht, maar hij geeft de positie van de eerste letter van "genaemt". je moet er dus nog 7 bij optellen.

Sub Scheiden_titel()
'
' Scheiden_titel Macro
Dim intPos, intRow
Dim rngRange, cell As Range
Dim strZoek As String

strZoek = "genaemt"

Set rngRange = Range("A2:A15")

For Each cell In rngRange
    'MsgBox cell.Row
    'MsgBox cell.Value
    intPos = InStr(1, Cells(cell.Row, 1).Value, strZoek) [COLOR="#FF0000"]+ 7[/COLOR]
    If intPos > 0 Then MsgBox Right(Cells(cell.Row, 1).Value, intPos)
    Cells(cell.Row, 2) = Left(Cells(cell.Row, 1).Value, intPos)
    Cells(cell.Row, 3) = Right(Cells(cell.Row, 1).Value, [COLOR="#FF0000"]Len(cell) -[/COLOR] intPos)
Next

End Sub

aanpassing op jouw code in het rood weergegeven.

 

[keb]

Bedankt Sjon voor de correcties. Het werkt!

 

[VenA]

Voor het splitsen bestaat de functie Split

Sub VenA()
  c00 = "genaemt"
  ar = Cells(1).CurrentRegion
  For j = 2 To UBound(ar)
    y = Split(ar(j, 1), c00)
    ar(j, 2) = y(0) & c00
    ar(j, 3) = Trim(y(1))
  Next j
  Cells(1).CurrentRegion = ar
End Sub

 

[snb]

Of eenvoudig (laat Excel voor jou het werk doen) zo:

Sub M_snb()
  Columns(1).Replace "genaemt", "|genaemt", 2
  Columns(1).TextToColumns , , , , 0, 0, 0, 0, 1, "|"
End Sub

Zoals je ziet kan dit ook in de UI (= handmatig: replace in tab find en texttocolumns in tab data)