Opsplitte formel i elementer

Sub opdel()
Dim f, lgd, rk, count, flag As Boolean
    rk = 3
    flag = True
    f = 1
   
    formel = Mid(Cells(1, 1).Formula, 2)
   
    While formel <> ""
        If InStr("+-*/", Mid(formel, f, 1)) > 0 Then
            If flag = True Then
                flag = False
            Else
                Cells(rk, 1) = "'" + Mid(formel, 1, f - 1)
                Cells(rk, 2) = "=" + Mid(formel, 1, f - 1)
               
                formel = Mid(formel, f)
                rk = rk + 1
                f = 1
            End If
        End If
        f = f + 1
    Wend
   
End Sub

En lille justering af 7. linie: (så formelcellen er vilkårlig)

    formel = Mid(ActiveCell.Formula, 2)

smukt - et lille men

kan man lave det således, at man står i for eksempel regneark XY, ark2, celle G5 - herefter opretter makroen et nyt regneark og kopiere formlen over i ark1 celle A1 - med de oprindelige referencer - inden ovenstående makro kører ?

Har løst det selv med tre nye linier før "While formel <> ""

    Workbooks.Add
    Cells(rk - 2, 1) = "'" + formel
    Cells(rk - 2, 2) = "=" + formel

Send et svar !

Ok - Der skulle være et svar i forbindelse med mit første indlæg.

Har måtte justere lidt på den - da den ikke virker, når der er * eller / i en formel. Har stadig problem med paranteser. Men det må kunne finjusteres.

Sub OpdelFormel()
Dim f, lgd, rk, cl, count, flag As Boolean
    rk = 1000
    cl = 1
    flag = True
    f = 1
   
formel = Mid(ActiveCell.Formula, 2)
'    Workbooks.Add
    Cells(rk, cl + 2) = "'" + formel
    Cells(rk, cl + 1) = "=" + formel
    rk = rk + 1
    While formel <> ""
        If InStr("+-*/", Mid(formel, f, 1)) > 0 Then
            If flag = True Then
                flag = False
            Else


                Cells(rk, cl + 2) = "'" + Mid(formel, 1, f - 1)
                Cells(rk, cl) = "'" + Mid(formel, 1, 1)
                Cells(rk, cl + 1) = "=" + Mid(formel, 2, f - 2)
               
                formel = Mid(formel, f)
                rk = rk + 1
                f = 1
            End If
        End If
        f = f + 1
    Wend
   
    Application.Goto Reference:="R1000C1"
End Sub

Eksempel, som virker med paranteser:

Sub OpdelFormel_parantes()
Dim f, lgd, rk, cl, count, flag As Boolean
    rk = 1000
    cl = 1
    flag = True
    f = 1
   
formel = Mid(ActiveCell.Formula, 2)
'    Workbooks.Add
   
    Cells(rk, cl + 2) = "'" + formel
    Cells(rk, cl + 1) = "=" + formel
    rk = rk + 1
formel = Replace(formel, "(", "", 1, -1)
formel = Replace(formel, ")", "", 1, -1)

    While formel <> ""
        If InStr("+-*/", Mid(formel, f, 1)) > 0 Then
            If flag = True Then
                flag = False
            Else


                Cells(rk, cl + 2) = "'" + Mid(formel, 1, f - 1)
                Cells(rk, cl) = "'" + Mid(formel, 1, 1)
                Cells(rk, cl + 1) = "=" + Mid(formel, 2, f - 2)
               
                formel = Mid(formel, f)
                rk = rk + 1
                f = 1
            End If
        End If
        f = f + 1
    Wend
   
    Application.Goto Reference:="R1000C1"
End Sub