Cel uitsplitsen op basis van spaties

[Timmiesch]

In Cel A1 staat het volgende:
00-00 00000 00:00 00:00 00:00 0000000 Scholten Dorpsstraat 14
Nu wil ik op een ander tabblad dit uitgesplitst hebben over de cellen A1:I1

Iemand die met een formule iets kan, splitsen op basis van de spaties die erin staan.
Tekst naar kolommen gaat niet op, omdat in cel A1/A6/A11/A16/A21/Etc alleen deze opmaak voorkomt en in de tussenliggende cellen andere indelingen.



Heb een bijlage toegevoegd Bekijk bijlage Map5.xls hierin staat een formule die ik nog had maar die ik niet volledig goed krijg, misschien dat iemand hier mee verder kan?

 

[PieterJanVdb]

Macrootje

Hoi

Ooit met macro's gewerkt? In het begin klinkt het Chinees (zo was het voor mij toch), maar eens je er wat mee gespeeld hebt, fantastisch!

Maak eens een nieuwe, lege macro aan en zwier er het volgende in:

Sub opdelen()
'
' opdelen Macro
'

'
Sheets("Blad1").Select
Range("A:A").Select
Selection.Copy
Sheets("Blad3").Select
Range("A1").Select
ActiveSheet.Paste

Do Until IsEmpty(ActiveCell)
   Selection.TextToColumns Destination:=ActiveCell, DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
        Array(7, 1), Array(8, 1), Array(9, 1)), TrailingMinusNumbers:=True

    
    ActiveCell.Offset(5, 0).Select

Loop
Sheets("Blad1").Select
Range("A1").Select
End Sub

Eventueel nog een knop ergens op je sheet plaatsen of een sneltoets aan koppelen en hij zou het moeten doen in no-time!

Ik hoop dat het lukt, anders hoor ik het wel.
Pieter-Jan

 

[Timmiesch]

Ik hoop dat het lukt, anders hoor ik het wel.
Pieter-Jan

Ik heb redelijk verstand van Excel maar Macro's blijven mij toch meestal een raadsel. Zo ook deze.
Zou jij hem in mijn testbestand kunnen gooien en laten zien hoe het werkt? Eventueel met een button erin?

Daarnaast mocht er iemand met een formuleoplossing zijn, dan houd ik me aanbevolen.

 

[PieterJanVdb]

maar Macro's blijven mij toch meestal een raadsel.

Dat ken ik, had ik vroeger ook! Tot ik zo ingewikkelde formules probeerde uit te dokteren in Excel ... Ik kan het alleen maar aanraden! Maar goed, de oplossing zou hierbij in je testbestandje moeten zitten. Op de blauwe knop drukken, even wachten en neem eens een kijkje op Blad3!
Ikzelf werk met Excel2007, maar ik verwacht geen problemen met eerdere versies. Ik hoop dat het lukt?

(Macro's natuurlijk wel inschakelen en indien nodig beveiligingsniveau 1 niveau lager zetten.)

Bekijk bijlage Map5_metopdeelfunctie.xls

 

[HSV]

Zou ik de screenupdating wel uit zetten, en later weer aan. (tegen het flikkeren van het beeld, en het laat de code sneller lopen).

 

[cow18]

of deze versie

Sub data()
  Dim s As String, splits As Variant, c As Range, lRow As Long

  With Sheets("blad1")                                     'blad met gegevens
    lRow = .Range("A" & Rows.Count).End(xlUp).Row          'laatste rij
    Set c = .Range("A1")                                   '1e rij
    Do
      s = s & c.Value & vbLf                               'in 1 string alle gegevens ophalen met vblf als separator
      Set c = c.Offset(5)                                  'ga 5 rijen verder staan
    Loop While c.Row <= lRow                               'loop tot laatste rij
  End With

  With Sheets("blad3")                                     'uitvoerblad
    .Cells.Clear                                           'leegmaken
    If s = "" Then Exit Sub                                'niets opgehaald=stoppen
    splits = Split(s, vbLf)                                'knip verzamelstring in stukjes op de separator vblf
    With .Range("A1").Resize(UBound(splits))               'uitvoerbereik
      .Value = WorksheetFunction.Transpose(splits)         'zet daar de knipsels in
      Application.DisplayAlerts = False                    'alarms uitzetten
      .TextToColumns DataType:=xlDelimited, ConsecutiveDelimiter:=True, Space:=True  'verder in stukjes knippen op " "                          'knipsels verder in stukjes knippen op de " "
      Application.DisplayAlerts = True                     'alarms weer aan
    End With
    .Rows(1).EntireColumn.AutoFit                          'kolombreedte aanpassen
  End With
End Sub

 

[PieterJanVdb]

Ja goed, screenupdating laat ik meestal voor de kleinere programma's zo, dan heb je nog een idee van waar hij mee bezig is. Stel dat je bijvoorbeeld de ActiveCell.Offset vergeten bent, dan doet hij er wel heel erg lang over ... !

Maar goed, onze vriend moet dan natuurlijk wel tevreden zijn met de "macro-oplossing"?

 

[Haaren101]

Als je al die .select 's weg laat dan gaat het nog veel beter en efficienter

Ron

 

[zapatr]

In Cel A1 staat het volgende:
00-00 00000 00:00 00:00 00:00 0000000 Scholten Dorpsstraat 14
Nu wil ik op een ander tabblad dit uitgesplitst hebben over de cellen A1:I1
Tekst naar kolommen gaat niet op, omdat in cel A1/A6/A11/A16/A21/etc. alleen deze opmaak voorkomt en in de tussenliggende cellen andere indelingen.

Zie bijlage.

 

[Timmiesch]

Ik kan vrij weinig met de macro's, het lost niet op waar ik tegen aanloop.
Het zou voor mij in deze situatie veel makkelijker zijn om dit met een formule op te lossen.

Toch bedankt voor de moeite, word uiteraard gewaardeerd. Mochten er nog mensen zijn met een formule dan hoor ik het graag.

 

[oeldere]

Tekst naar kolommen gaat niet op, omdat in cel A1/A6/A11/A16/A21/Etc alleen deze opmaak voorkomt en in de tussenliggende cellen andere indelingen.

ik heb dit gemaakt met tekst naar kolommen.

volgens mij is dit de opmaak zoals jij wilt.

dit is gemaakt met excel 2007, maar waarschijnlijk zal dit dan in de 2003-versie ook kunnen.

Laat je even weten, of dit voldoet?

 

[zapatr]

Ik kan vrij weinig met de macro's, het lost niet op waar ik tegen aanloop.

Dat bestrijd ik.
Al zou elke rij verschillend van opmaak zijn, met mijn macro kan de tekst in elke rij keurig verdeeld worden over kolommen. Zoals de macro NU is, worden weliswaar alleen de rijen , 6, 11, 16, 21, enz. gesplitst, maar dat is omdat ik uit je eerste bericht begreep dat je alleen voor die rijen een oplossing wilde. Maar als je in de macro in de vierde regel van onder x = x + 5 vervangt door x = x + 1, dan splitst de macro elke rij, ongeacht de opmaak ervan.

 

[Timmiesch]

Dat bestrijd ik.
Al zou elke rij verschillend van opmaak zijn, met mijn macro kan de tekst in elke rij keurig verdeeld worden over kolommen. Zoals de macro NU is, worden weliswaar alleen de rijen , 6, 11, 16, 21, enz. gesplitst, maar dat is omdat ik uit je eerste bericht begreep dat je alleen voor die rijen een oplossing wilde. Maar als je in de macro in de vierde regel van onder x = x + 5 vervangt door x = x + 1, dan splitst de macro elke rij, ongeacht de opmaak ervan.

Ja begrijp je punt, heb het nu met de macro gedaan en is gelukt. Gelukkig is het een eenmalige handeling, ben geen ster met macro's! Bedankt

 

[oeldere]

Timmisch kun je dan ook nog even laten weten of mijn oplossing van #11 ook voldoet?

 

[Timmiesch]

Timmisch kun je dan ook nog even laten weten of mijn oplossing van #11 ook voldoet?

Deze is ook werkbaar, voorkeur ging uit naar een formule maar die niet gekregen dus met een macro het opgelost. Bedankt