Trække periode ud af tekstfelt

I hvilken kontekst er teksten - regneark?

Det er tekstfelt i excel

Skal resultat(erne) placeres i hver sin kolonne?

Gerne i hver sin kolonne som vist i eksemplet - og hvis hele datoen kan trækkes ud eks 050113 så vil det være ideelt ellers kun måned år

Rem Anbringes under relevante ark
rem Evt. formater kolonner t/tekst for at få foranstillet nul i datoerne
rem ============================================================
Const startRæk = 1                                  'kan justeres

Dim antalRæk As Long, ræk As Long
Dim tekst As String
Public Sub udtrækDatoer()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    For ræk = startRæk To antalRæk
        tekst = Range("A" & ræk)
       
        findDatoer tekst
        If resultat <> "" Then
            Range("C" & ræk) = resultat
        End If
    Next ræk
End Sub
Private Sub findDatoer(tekst)
Dim x As Integer, antal As Integer, tabel As Variant
    antal = 0
    tabel = Split(tekst, " ")
    For x = 0 To UBound(tabel)
        If IsNumeric(tabel(x)) = True Then
           
            antal = antal + 1
            Range("A" & ræk).Offset(0, antal) = tabel(x)
        End If
    Next x
End Sub

Den er lige i skabet :-)
1.000 tak for hurtig assistance

Fint & selv tak

Hej igen.... håber på lidt hjælp til koden da jeg er stødt ind i lidt udfordringer med det tekstfelt som koden skal trække dato/perioden ud af.
Hvis der står andre tal i tekstfeltet skrives disse i de efterfølgende felter.
Eks. hvis der står Hent 5 l mælk, 2 l fløde og 1 citron så sætterden felterne til 5 2 og 1
Er det muligt, at den kun henter datoer ud som opfylder formatet eks 010113.
Derudover lidt udfordringer hvis bindestreg i posteringsperiode står som henholdsvis 010113-310113 eller 010113 - 310113

Håber det giver mening det jeg skriver og jeg kan få lidt hjælp

Lars

Hej Lars

Ser på det..

Rem Version 2
Rem =========
Rem Anbringes under relevante ark
Rem Evt. formater kolonner t/tekst for at få foranstillet nul i datoerne
Rem ============================================================
Const startRæk = 1                                  'kan justeres

Dim antalRæk As Long, ræk As Long
Dim tekst As String
Public Sub udtrækDatoer()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    For ræk = startRæk To antalRæk
        tekst = Range("A" & ræk)
       
        findDatoer tekst
        If resultat <> "" Then
            Range("C" & ræk) = resultat
        End If
    Next ræk
End Sub
Private Sub findDatoer(tekst)
Dim x As Integer, antal As Integer, tabel As Variant
    antal = 0
Rem er der bindestreg
    If InStr(tekst, "-") > 0 Then
        If InStr(tekst, " - ") = 0 Then
            tekst = Replace(tekst, "-", " - ")
        End If
    End If
   
    tabel = Split(tekst, " ")
    For x = 0 To UBound(tabel)
        If IsNumeric(tabel(x)) = True Then
            If Len(tabel(x)) = 6 Then
                antal = antal + 1
                Range("A" & ræk).Offset(0, antal) = tabel(x)
            End If
        End If
    Next x
End Sub

Hej "Supertekst"
Hvis der står et tegn/bogstav lige efter dato eks.
011013-311013,så sættes den sidste dato 311013 ikke - men ellers virker koden fint.

Rem Version 3
Rem =========
Rem Anbringes under relevante ark
Rem Evt. formater kolonner t/tekst for at få foranstillet nul i datoerne
Rem ============================================================
Const startRæk = 1                                  'kan justeres

Dim antalRæk As Long, ræk As Long
Dim tekst As String
Public Sub udtrækDatoer()
    antalRæk = ActiveCell.SpecialCells(xlLastCell).Row
    For ræk = startRæk To antalRæk
        tekst = Range("A" & ræk)
       
        findDatoer tekst
        If resultat <> "" Then
            Range("C" & ræk) = resultat
        End If
    Next ræk
End Sub
Private Sub findDatoer(tekst)
Dim x As Integer, antal As Integer, tabel As Variant
    antal = 0
Rem er der bindestreg
    If InStr(tekst, "-") > 0 Then
        If InStr(tekst, " - ") = 0 Then
            tekst = Replace(tekst, "-", " - ")
        End If
    End If
   
    tabel = Split(tekst, " ")
    For x = 0 To UBound(tabel)
        If Len(tabel(x)) > 6 Then
            tabel(x) = Left(tabel(x), 6)
        End If
       
        If IsNumeric(tabel(x)) = True Then
            If Len(tabel(x)) = 6 Then
                antal = antal + 1
                Range("A" & ræk).Offset(0, antal) = tabel(x)
            End If
        End If
    Next x
End Sub