inhoud van 1 cel overbrengen naar een andere cel

[loecni]

Excel97
In een mij toegestuurd bestand bevat elke cel van kolom A 5 regels onder elkaar, waarschijnlijk door gebruik van de Alt+Enter-toets.
Deze 5 regels kunnen niet door Kopieren, Plakken speciaal, Transpose naast elkaar gebracht worden.
De lengte van de eerste regel van cel A1 verschilt altijd van deze in cel A2 enz.
Een formule met Links(celverwijzing;aantal tekens) of Rechts(celverwijzing;aantal tekens) kan dus niet gebruikt worden.
Welke oplossing hebben jullie hiervoor?

 

[jean42]

Ik heb vanalles geprobeerd maar het lukt niet en ik vrees voor u dat het ook niet gaat.

mvg

jean

 

[Wim1960]

Ik wil best kijken, maar plaats dan even het werkblad.

 

[loecni]

Zeer klein extract uit het bestand bijgevoegd.
Mijn vraag is misschien zo wat beter te verstaan

 

[jean42]

Beste

Gevonden!!
Rechtsklikken op cel, eigenschappen, tabblad uitlijning, daar staat ergens terugloop met een vinkje voor, dat vinkje wegdoen.
Dan staat alles naast elkaar in één cel, ge moet wel de cel nadien groter vinken.

veel succes ermee

jean

 

[Jan van Asseldonk]

Hier was terugloop dus aangezet.
Indien het wel met Alt+Enter is verdeeld over meerdere regels kun je het met de volgende macro terug zetten naar één regel.

Sub Teksten()
'
' Teksten Macro
' De macro is opgesteld op 19-3-2004 door Jan van Asseldonk.
' De tekst die met Alt+Enter over meerdere regels is verdeeld
' wordt hiermee teruggezet naar 1 regel.
' De Alt+Enter, =chr$(10), wordt vervangen door een spatie.
' Celverwijzingen zelf aanpassen
'
Dim myTekst1, myTekst2 As String

'
Range("A1").Select
For i = 1 To Len(Range("a1").Formula)
myTekst1 = Mid(Range("A1").Formula, i, 1)
If myTekst1 = Chr$(10) Then
myTekst1 = " "
End If
myTekst2 = myTekst2 + myTekst1
Next
Range("B1").Formula = myTekst2
End Sub

 

[loecni]

Jean en Jan, beide dank voor de tip
Maar ik wil eigenlijk dat de eerste regel van A1 in B1 komt, de tweede regel van A1 in C1, de derde regel van A1 in D1 enz....
Is dat mogelijk?

 

[jean42]

Ik vrees dat het nu intypen wordt!!!!
Dit is echt niet mogelijk denk ik.

jean

 

[jzeedijk]

Hoi Loecni,

Sorry bestandje gemist

D1: =DEEL(A1;1;VIND.SPEC(TEKEN(10);A1)-1)

E1: =DEEL(A1;LENGTE(D1)+2;VIND.SPEC(TEKEN(10);A1;LENGTE(D1)+2)-LENGTE(D1)-2)

F1: =DEEL(A1;LENGTE(D1)+LENGTE(E1)+3;VIND.SPEC(TEKEN(10);A1;LENGTE(D1)+LENGTE(E1)+3)-LENGTE(D1)-LENGTE(E1)-3)

G1: =DEEL(A1;LENGTE(D1)+LENGTE(E1)+LENGTE(F1)+4;VIND.SPEC(TEKEN(10);A1;LENGTE(D1)+LENGTE(E1)+LENGTE(F1)+4)-LENGTE(D1)-LENGTE(E1)-LENGTE(F1)-4)

Jeroen

 

[loecni]

Jeroen,
Het nadeel van jouw voorstel is dat het aantal karakters verschilt van cel tot cel; dus dit lijkt mij niet handig omdat ik een 400-tal rijen heb.
Ik wacht nog enkele dagen op reacties; daarna sluit ik dit item af.
Toch bedankt!

 

[jzeedijk]

Hoi Loecni,

Terwijl jij typte verbeterde ik mijn oplossing.

Jeroen

 

[loecni]

Jeroen,
Prima oplossing!
Dank voor de snelle reacties

 

[fra]

Sub test()
Dim x As Integer, y As Integer, z As Integer
Columns("B:G").ClearContents
z = 1
Do Until Cells(z, 1).Value = ""
y = 2
For x = 1 To Len(Cells(z, 1).Value)
If Mid(Cells(z, 1), x, 1) <> Chr(10) Then
Cells(z, y).Value = Cells(z, y).Value & Mid(Cells(z, 1), x, 1)
Else
y = y + 1
End If
Next x
z = z + 1
Loop
Columns("A:G").AutoFit
End Sub

fra.