Splitning af indhold i celler i excel regneark

Jeg har set at du søger en vba-løsning, men du får alligevel lige en almindelig formel der kan klare det
Indsæt denne i H6

=MIDT($C6 & $D6 & $E6 & $F6; KOLONNE() - 7; 1)

Træk/kopier hele vejen hen til T6
Kopier derefter H6:T6 nedad så langt du har data.

Ja den kan klare det, men jeg søger en VB-løsning, således at der ikke står formler i de udfyldte celler, ellers kan jeg ikke bruge f.eks en  hvis(funktion),    hvis(h6=1;1;0), den virker ikke når der er formler i cellerne.
Men ellers mange tak for hjælpen. Jeg håber stadigvæk på at nogen kan hjælpe mig med en VB-løsning.

Du mener en VBA løsning ;o)

30 sek...

Sub Martin_Macro()

    Dim lngROW As Long
    Dim lngCOL As Long
    Dim strCellContent As String
    Dim i As Long
    Dim MyChar As String
   
    For lngROW = 6 To 20 'Rækkerne 6 til 20 - skift selv rækkenumre
      For lngCOL = 3 To 7 'kolonnerne C til F - skift selv kolonnenumre
        Cells(lngROW, lngCOL + 4).Value = ""
        strCellContent = Cells(lngROW, lngCOL).Value
        Cells(lngROW, lngCOL).Value = ""
        If Len(strCellContent) > 0 Then
          For i = 1 To Len(strCellContent)
            MyChar = Mid(strCellContent, i, 1)
            If (Asc(MyChar) < 58) And (Asc(MyChar) > 47) Then
              Cells(lngROW, lngCOL).Value = Cells(lngROW, lngCOL).Value & MyChar
            Else
              Cells(lngROW, lngCOL + 4).Value = Cells(lngROW, lngCOL + 4).Value & MyChar
            End If
          Next i
        End If
      Next lngCOL
    Next lngROW
    MsgBox "Så får du ikke mere for den 25-øre"
End Sub

Mange tak for forslaget.
Det ser meget indviklet ud for mig, men jeg har prøvet programmet,og det virkede ikke efter hensigten. Husk der er både tal og bogstaver i kolonnerne C6:F6. Programmet flyttede kun bogstaverne og ikke tallene. Er der f.eks 2 bogstaver i en celle  12ab  , så flytter programmet både a og b til samme celle. "Jeg må bruge en 25-øre mere.

Ahhh - havde læst det somom du ville sortere bogstaverne fra. Det er det koden gør. Du får en ny senere. Men det kræver jo, at der maks er 4 tegn i hver celle!!!

Denne macro deler indholdet af C6 ud på H6-K6 (4 felter) og tilsvarende for de andre celler.

Så står indholdet af kol. C altid i kol H-K
Så står indholdet af kol. D altid i kol L-O
Så står indholdet af kol. E altid i kol P-S
Så står indholdet af kol. F altid i kol T-W

Hvis der så er færre end 4 karakterer i en celle, vil de karakterer der er der blive skrevet på deres nye pladser, og dem der "mangler" bliver der gjort plads til.

Således står f.eks. 3. karakter i kolonne D ALTID i kolonne N - og er der kun 2 karakterer i kolonne D, er kolonne N tom.

Det er vel det mest overskuelige (nu aner jeg jo ikek hvad du vil bruge det til)

Man kan også droppe det med at gøre plads, og have tomem celler

Sub Martin_NY_Macro()

    Dim lngROW As Long
    Dim lngCOL As Long
    Dim strCellContent As String
    Dim i As Long
    Dim SplitArray() As String
    Dim lngCOLcount As Long
   
    For lngROW = 6 To 20 'Rækkerne 6 til 20 - skift selv rækkenumre
      For lngCOL = 3 To 6 'kolonnerne C til F - skift selv kolonnenumre
       
        strCellContent = Cells(lngROW, lngCOL).Value
       
        If (Len(strCellContent) > 0) And (Len(strCellContent) < 5) Then
          lngCOLcount = lngCOL - 2
          For i = 1 To Len(strCellContent)
            MyChar = Mid(strCellContent, i, 1)
            Cells(lngROW, 1 + lngCOL + i + (3 * lngCOLcount)).Value = MyChar
          Next i
        End If
      Next lngCOL
    Next lngROW
    MsgBox "Så får du ikke mere for den 25-øre"
End Sub

Der er altid max 4 tegn pr celle, og der skal ikke gøres plads til tomme celler.

Du får din vilje:

Sub Martin_NY_Macro()

    Dim lngROW As Long
    Dim lngCOL As Long
    Dim strCellContent As String
    Dim i As Long
    Dim SplitArray() As String
   
    For lngROW = 6 To 20 'Rækkerne 6 til 20 - skift selv rækkenumre
      strCellContent = ""
      For lngCOL = 3 To 6 'kolonnerne C til F - skift selv kolonnenumre
        If (Len(Cells(lngROW, lngCOL).Value) > 0) And (Len(Cells(lngROW, lngCOL).Value) < 5) Then
          strCellContent = strCellContent & Cells(lngROW, lngCOL).Value
        End If
      Next lngCOL
      For i = 1 To Len(strCellContent)
        MyChar = Mid(strCellContent, i, 1)
        Cells(lngROW, 1 + lngCOL + i + (3 * lngCOLcount)).Value = MyChar
      Next i
    Next lngROW
    MsgBox "Så får du ikke mere for den 25-øre"
End Sub

OK mange tak for hjælpen, nu virker det som det skal, selv om indsætningsområdet nu er rykket en kolonne fra (H6:T6) til (I6:U6).

Det kan du jo bare rykke derhen hvor du vil - kik på linien

Cells(lngROW, 1 + lngCOL + i + (3 * lngCOLcount)).Value = MyChar

Den kan du ændre i indtil det passer med hvad du vil