Adresse i én celle skal deles ud i 4 celler

brug excel og tekst til kolonner

du finder tekst til kolonner i data hovedmenuen

kopier kun teksten fra den celle hvor de 4 linjer er og så sæt ind i cellen under så fordeler den sig selv i 4 celler

Ja de virker jo begge måder. Men problemet er, at jeg har 100 af disse, derfor skal de helst kunne laves på én gang :( Efter at have testet tekst til kolonner, synes jeg det ser ud som om det ikke kan lade sig gøre?

Indsæt denne formel i B1 og kopier ned =UDSKIFT(A1;TEGN(10);";")
Marker kolonne B og kopier. Vælg indsæt, speciel, værdier (under menuen rediger) i kolonne C
Marker kolonne C og Herefter tekst til kolonner, semikolon sepereret.

Sub dele()
Dim i, txt, txt2, rk, rw
For rk = 1 To 100
txt = ActiveCell.Value: ActiveCell.Offset(0, 1).Activate
For i = 1 To Len(txt)
If Mid(txt, i, 1) = Chr(10) Then ActiveCell.Offset(0, 1).Activate: txt2 = "": GoTo om
txt2 = txt2 & Mid(txt, i, 1)
ActiveCell.Value = txt2
om:
Columns.AutoFit: Rows.AutoFit
ActiveCell.WrapText = False
Next
ActiveCell.Offset(1, 0).Select
ActiveCell.End(xlToLeft).Activate
Next
End Sub

en lille rettelse:

Sub dele()
Dim i, txt, txt2, rk
Application.ScreenUpdating = False
For rk = 1 To 100
txt = ActiveCell.Value: ActiveCell.Offset(0, 1).Activate
  For i = 1 To Len(txt)
  If Mid(txt, i, 1) = Chr(10) Then ActiveCell.Offset(0, 1).Activate: txt2 = "": GoTo om
    txt2 = txt2 & Mid(txt, i, 1)
    ActiveCell.Value = txt2
om:
    ActiveCell.WrapText = False
  Columns.AutoFit: Rows.AutoFit
  Next
ActiveCell.Offset(1, 0).Select
ActiveCell.End(xlToLeft).Activate
txt2 = ""
Next
Application.ScreenUpdating = True
[a1].Activate
End Sub

'Marker første celle

Sub dele()
Dim i, txt, txt2, rk, kol
Application.ScreenUpdating = False
kol = ActiveCell.Column
For rk = 1 To 100
txt = ActiveCell.Value: ActiveCell.Offset(0, 1).Activate
  For i = 1 To Len(txt)
  If Mid(txt, i, 1) = Chr(10) Then ActiveCell.Offset(0, 1).Activate: txt2 = "": GoTo om
    txt2 = txt2 & Mid(txt, i, 1)
    ActiveCell.Value = txt2
om:
    ActiveCell.WrapText = False
    Columns.AutoFit: Rows.AutoFit
  Next
  ActiveCell.End(xlToLeft).Activate
ActiveCell.Offset(1, 0).Select
txt2 = ""
Next
Application.ScreenUpdating = True
[a1].Activate
End Sub

Sub del()

Dim b

Application.ScreenUpdating = False
Range("b:f").ClearContents

For Each a In Range(("a1"), Range("a65536").End(xlUp))
    b = Replace(a, Chr(10), ";")
    a.Offset(0, 1) = b
Next

Columns("b:b").Select
    Selection.TextToColumns Destination:=Range("b1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, Semicolon:=True, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
        TrailingMinusNumbers:=True
    Range("a1").Select
   
Application.ScreenUpdating = True

End Sub


Tja excelent, så må vi se om vi får noget respons på vores "guldkorn" :o)

eller marker cellerne med adressen og kør denne

Sub test()
  Dim rCell As Range
  For Each rCell In Selection
      rCell(1, 2).Resize(, 4) = Split(rCell, Chr(10))
  Next
End Sub

Ja den er godt nok noget kortere og kønnere bak :-)
Jeg kan forstå at split deler strengen i 4 understrenge som herefter indlæses i rCell, men hvad sker der her: rCell(1, 2).Resize(, 4) ? Giver gerne nogen Point

Det koster gratis, mrjh
rCell(1,1) er aktuel celle
rCell(1,2) er cellen tilhøjre for aktuel celle
Resize(,4) udvider et range 4 kolonner. Da rangen/området her er en enkelt celle (rCell(1,2)) bliver det udvidet til 4 celler som så fyldes af de 4 dele i split.
Håber jeg har beskrevet det så det er til at forstå :-)

Tusind tak, bak. Super forklaring og tillad mig så i det mindste at give dig noget karma :-)

Selv tak, mrjh og tak for karma.

inspireret af din egen makro har jeg lavet denne one-liner (det er faktisk een sammenhængende linie)

Sub Macro1()
        Columns("A:A").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="" & Chr(10) & "", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), _
        TrailingMinusNumbers:=True
End Sub

jow jow. hvis jeg kunne skrue dem sån' sammen, ville jeg f.... ik' lave andet :-)

Super !! Brugte den fra Bak, den virkede præcis som den skulle :)

Står nu med et andet tema. Skal have op til 4 seperate kolonner samlet i et felt, og helst med linieskift mellem dem. Er der nogen der har et hurtigt bud, ellers opretter jeg en ny tråd.

Brug en formel som denne. Sæt formatering til ombryd tekst

= C3 & TEGN(10)  & D3 & TEGN(10) & E3 &TEGN(10) & F3

husk at lægge et svar bak - den lille sag er alle point værd :-) well done

OK :-)

Det var dog utroligt

Ja der er vist nogen det ikke er værd at ofre mere tid på :-(