Waarden uit cellen halen

[kees130]

Beste leden,

Ik zou graag bepaalde waarden uit cellen willen halen (zie bijlage).
In kolom A staan waarden. In kolommen C, D en E heb ik aangegeven hoe ik het graag zou willen hebben.
Is dit mogelijk?

Alvast bedankt.

Groet,
Kees

 

[JEC.]

Dat kan het beste met een UDF (in dit geval heb ik er 2 gebruikt)

 

[HSV]

De Split-functie heeft bij geen opgave van het scheidingsteken standaard de spatie.

 

[JEC.]

Klopt, uit automatisme zet ik de spatie er soms nog in. Maar t werkt!

 

[VenA]

Of 1 UDF zonder verdere formules

Function VenA(r, j)
  x = Split(Replace(r, " ", "/"), "/")
  VenA = ""
  If UBound(x) + 1 >= j Then
    If IsNumeric(x(j - 1)) Then VenA = --(x(j - 1))
  End If
End Function

 

[HSV]

Een UDF vind ik persoonlijk meer geschikt voor maar een kolom breed.

Sub hsv()
Dim sv, hs, i As Long, j As Long
sv = Cells(1).CurrentRegion
ReDim a(UBound(sv), 0)
 For i = 1 To UBound(sv)
  hs = Split(Replace(sv(i, 1), " ", "/"), "/")
   For j = 0 To UBound(hs)
    If IsNumeric(hs(j)) Then
      If UBound(a, 2) < j Then ReDim Preserve a(UBound(sv), UBound(a, 2) + 1)
       a(i - 1, j) = hs(j)
    End If
   Next j
 Next i
 Cells(1, 10).Resize(UBound(sv), UBound(a, 2) + 1) = a
End Sub

 

[kees130]

Allen bedankt voor jullie input.

@Jveer, het werkt inderdaad, top.
@VEnA, ik krijg de foutmelding #Waarde.
@HSV, het is erg gemakkelijk met een VBA code, dankjewel.
Maar waarom krijg ik een foutmelding bij onderstaande gegevens:

3951213 Blk H 44
DEP/DNT/HUG
9332955
KLX/P7ge 3327317
7736013 B6lk H 44
3326948
5532961
KTX 811275
DEP/DNT
KLX 2056005/8392450

 

[HSV]

Aanpassing:

Sub hsv()
Dim sv, hs, i As Long, j As Long, x as long, y as long
sv = Cells(1).CurrentRegion
ReDim a(UBound(sv), 0)
 For i = 1 To UBound(sv)
  hs = Split(Replace(sv(i, 1), " ", "/"), "/")
   For j = 0 To UBound(hs)
    If IsNumeric(hs(j)) Then
          a(i - 1, x) = hs(j)
          x = x + 1
          if y < x then y = x
       ReDim Preserve a(UBound(sv), y)
    End If
   Next j
  x = 0
 Next i
 Cells(1, 10).Resize(UBound(sv), y) = a
End Sub

 

[VenA]

@VEnA, ik krijg de foutmelding #Waarde.

Ik niet.

 

[kees130]

Allen,

Hartelijk dank voor jullie hulp.
Wat een kennis bezitten jullie.

Ik ga de vraag op opgelost zetten.

Groet,
Kees