Karakters na bepaald teken retourneren

[marka]

Goedenavond,

Ik heb een groot databestand en wil na een bepaald karakter (namelijk "|")de tekst die daarachter staan terug hebben. Als dit karakter er niet in staat moet hij alle tekst retourneren.

Ik heb een code gevonden op het forum, maar krijg hem ook na veel proberen niet voldoende aangepast. Hij pakt de laatste tekstreeks na "|" niet.

Public Function Omdraaien(Tekst As String)
    Omdraaien = StrReverse(Tekst)
End Function

Function Woord_Nr(Tekst As String, WNr) As String
Dim Aantal_Woorden As Long
  With Application.WorksheetFunction
  Aantal_Woorden = Len(Tekst) - Len(.Substitute(Tekst, " ", "")) + 1
    If WNr <= 1 Then
      Woord_Nr = Left(Tekst, .Find(" ", Tekst) -1)
    ElseIf Aantal_Woorden <= WNr Then
      Woord_Nr = StrReverse(Left(StrReverse(Tekst), .Find(" ", StrReverse(Tekst)) - 1))
    Else
      Woord_Nr = Mid(Mid(Mid(.Substitute(Tekst, " ", "~", WNr - 1), 1, 256), .Find("~", .Substitute(Tekst, " ", "~", WNr - 1)), 256), 2, .Find(" ", Mid(Mid(.Substitute(Tekst, " ", "~", WNr - 1), 1, 256), .Find("~", .Substitute(Tekst, " ", "~", WNr - 1)), 256)) - 2)
    End If
  End With
End Function

Public Function Aantal_Woorden(Tekst As String)
    Aantal_Woorden = Len(Tekst) - Len(WorksheetFunction.Substitute(Tekst, " ", "")) + 1
End Function

Ik heb een voorbeeld bestand toegevoegd (met mijn eigen aangepaste code). Ik wil het overigens niet met tekst naar kolommen oplossen.

 

[JEC.]

=ALS.FOUT(RECHTS(A2;LENGTE(A2)-VIND.SPEC("@";SUBSTITUEREN(A2;"|";"@";LENGTE(A2)-LENGTE(SUBSTITUEREN(A2;"|";"")));1));A2)

In G2

 

[VenA]

Is dit niet voldoende als UDF?

Function VenA(R1 As Range, j As Long)
  y = Split(R1, "|")
  If UBound(y) + 1 >= j Then c00 = Trim(y(j - 1))
  VenA = IIf(Len(c00), c00, "")
End Function

 

[JEC.]

@Cow, hij wil het niet met tekst naar kolommen oplossen.

 

[VenA]

En ook niet met een niet consistente formule

 

[popipipo]

=IFERROR(@Woord_Nr($A2&"|";@COLUMN(A:A));"")

Misschien met deze kleine aanpassing?

 

[HSV]

Dat is geen klusje voor een UDF (hoe diep wil je naar rechts?).

Dim sv, sq, i As Long, j As Long, n As Long
sv = Cells(1).CurrentRegion
ReDim a(UBound(sv), 0)
For i = 1 To UBound(sv)
 a(i - 1, 0) = sv(i, 1)
 sq = Split(sv(i, 1), "|")
 If UBound(sq) > 0 Then
   For j = 1 To UBound(sq)
     If UBound(sq) >= n Then
       n = n + 1
       ReDim Preserve a(UBound(sv), n)
     End If
       a(0, n) = "kolom " & n
       a(i - 1, j) = sq(j)
   Next j
  End If
 Next i
 Cells(1).Resize(UBound(sv), n + 1) = a
 Columns.AutoFit
End Sub

Ander resultaat en eenvoudiger.

Sub hsv()
Dim sv, sq, i As Long, j As Long, n As Long
sv = Cells(1).CurrentRegion
Cells(1).CurrentRegion.Offset(, 1).ClearContents
ReDim a(UBound(sv), 0)
For i = 1 To UBound(sv)
 sq = Split(sv(i, 1), "|")
   For j = 0 To UBound(sq)
     If UBound(sq) > n Then
       n = n + 1
       ReDim Preserve a(UBound(sv), n)
     End If
       a(0, j) = "kolom " & j + 1
       a(i - 1, j) = sq(j)
   Next j
 Next i
 Cells(1, 2).Resize(UBound(sv), n + 1) = a
 Columns.AutoFit
End Sub

 

[AlexCEL]

Deze in C2?

=SPATIES.WISSEN(SUBSTITUEREN(DEEL(SUBSTITUEREN("|"&$A2&HERHALING(" ";6);"|";HERHALING("^";250));KOLOM(A2)*250;250);"^";""))

Kun je doortrekken naar rechts en naar onder.

 

[marka]

Deze in C2?

=SPATIES.WISSEN(SUBSTITUEREN(DEEL(SUBSTITUEREN("|"&$A2&HERHALING(" ";6);"|";HERHALING("^";250));KOLOM(A2)*250;250);"^";""))

Kun je doortrekken naar rechts en naar onder.

Dank voor de berichten. Deze formule lijkt goed te werken. Stel mijn informatie staat in kolom F, wat moet ik dan aanpassen want A2 vervangen door F2 werkt niet.

Edit: Volgens mij altijd Kolom (Axx) aanhouden waar nu Kolom(A2) staat.

Ik wil het overigens wel met een consistente formule oplossen, misschien was ik niet helemaal duidelijk maar zou ook graag de code die ik heb gepost gebruiken, maar dan aangepast zodat ik die overal kan gebruiken in de worksheet.

Niet en een formule en een VBA code naast elkaar, maar nogmaals als ik de formule van Alex helemaal werkend krijgt moet dat denk ik lukken. Ik ga ook even kijken naar de geboden VBA oplossingen.

 

[marka]

=IFERROR(@Woord_Nr($A2&"|";@COLUMN(A:A));"")

Misschien met deze kleine aanpassing?

Volgens mij werkt deze ook! Volgens mij als ik een kolom toevoeg moet ik $A2 altijd laten verwijzen naar de betreffende kolom en wel Column A:A altijd aanhouden?

 

[AlexCEL]

Volgens mij altijd Kolom (Axx) aanhouden waar nu Kolom(A2) staat.

Correct. Dit geeft een reeks 1,2,3,4,... bij doortrekken. Dus altijd beginnen bij A.