Range for Excelformel

Marker din formel-selle og kør sub

Sub Reprecents()
minAdresse = ActiveCell.Precedents.Address
Range(minAdresse).Select
End Sub

Her med delt selle.argument

Sub Reprecents()
Dim minAdresse, adr1, adr2
minAdresse = ActiveCell.Precedents.Address
Range(minAdresse).Select
adr1 = Left(minAdresse, WorksheetFunction.Find(":", minAdresse) - 1)
adr2 = Mid(minAdresse, WorksheetFunction.Find(":", minAdresse) + 1, Len(minAdresse))
MsgBox ("") & minAdresse
MsgBox ("") & adr1
MsgBox ("") & adr2
End Sub

Jeg har måske ikke udtrykt mig helt klar men, metoden skal være GENEREL.
Den skal virke på en hvilken som helst formel.
Uanset udseende.

Jeg håbede at range havde en metode som kunne returnere de enkelte argumenters adresse.

Et forsøg:

For Each pr In ActiveCell.Precedents
    pa = pr.Address
Next

Desværre. Det vil heller ikke adskille de enkelte argumenter, men giver bare de enkelte celler i det område, som indgår i HELE formlen.

For at forklare nærmere vil jeg gerne for
"=LINREGR($C$11:$C$18;$B$11:$B$18)"
have
1) $C$11:$C$18
2)$B$11:$B$18
retur

For "=(B11-A11)/(C11-A11)*100"
vil jeg gerne have
1) B11
2) a11
3) c11
retur

og så fremdeles for alle andre formler.

Endnu et forsøg - for hver formel vises "bestanddelene" i en message-box - håber du kan komme videre herfra:

Sub test()
Dim antalR, antalK
Worksheets("Ark1").Activate
Rem find dimensioner for arket
    antalR = ActiveCell.SpecialCells(xlLastCell).Row
    antalK = ActiveCell.SpecialCells(xlLastCell).Column
   
    For r = 1 To antalR
        For k = 1 To antalK
            If Cells(r, k).HasFormula = True Then
                formelElementer r, k
            End If
        Next k
    Next r
End Sub
Private Sub formelElementer(r, k)
Dim antalKol, element As String
   
    Cells(r, k).Select
    element = ActiveCell.Formula + vbCr
   
    ActiveCell.ShowPrecedents
    antalKol = ActiveCell.Precedents.Columns.Count
   
    For e = 1 To antalKol
        Cells(r, k).Select
        ActiveCell.ShowPrecedents
       
        ActiveCell.NavigateArrow True, e
        element = element + Selection.Address + vbCr
        Cells(r, k).Select
        ActiveCell.ShowPrecedents Remove:=True
    Next e
   
    MsgBox (element)
End Sub

Det må jeg lige kikke på i aften Vender tilbage

OK

Jeg er imponeret!
Virkelig smart.
Det var netop det jeg søgte.
100 point er helt klart hjemme!

Hvis du kan tilrette funktionen så den virker på hvis en af argumenterne findes i et andet ark giver jeg 50 point til?
F.eks. ved funktionen :=LOPSLAG(A11;Ark2!A1:B19;2;FALSK).

Øhh: Jeg er ny bruger og har aldrig givet point før. Hvordan gør jeg ?

Koppelgaard

Tak for det - Vedr. x-tra - det skal jeg se på..
Du får et svar fra mig - som du så accepterer...

Version X:
Dim makroNavn As String
Sub test()
Dim antalR, antalK
Worksheets("Ark1").Activate
Rem find dimensioner for arket
    antalR = ActiveCell.SpecialCells(xlLastCell).Row
    antalK = ActiveCell.SpecialCells(xlLastCell).Column
   
    For r = 1 To antalR
        For k = 1 To antalK
            If Cells(r, k).HasFormula = True Then
                formelElementer r, k
            End If
        Next k
    Next r
End Sub
Private Sub formelElementer(r, k)
Dim antalKol, element As String, arkNavn
   
    Cells(r, k).Select
    element = ActiveCell.Formula + vbCr
   
Rem Test om henv. til andet ark
    If InStr(element, "!") > 0 Then
        arkNavn = isolerArk(element)
    End If
   
    ActiveCell.ShowPrecedents
    antalKol = ActiveCell.Precedents.Columns.Count
   
    For e = 1 To antalKol
        Cells(r, k).Select
        ActiveCell.ShowPrecedents
       
        ActiveCell.NavigateArrow True, e
        element = element + arkNavn + Selection.Address + vbCr
       
        If arkNavn = "" Then
            Cells(r, k).Select
        End If
       
        ActiveCell.ShowPrecedents Remove:=True
       
        If arkNavn <> "" Then
            ActiveWorkbook.Sheets(1).Activate
            ActiveCell.ShowPrecedents Remove:=True
        End If
    Next e
   
    MsgBox (element)
End Sub
Private Function isolerArk(element)
Dim p
    p = InStr(element, "!")
    For f = p To 1 Step -1
        tegn = Mid(element, f, 1)
        If InStr("(;,=", tegn) > 0 Then
            isolerArk = Mid(element, f + 1, p - f)
            Exit Function
        End If
    Next f
    isolerArk = ""
End Function

Troede egentlig at jeg havde sendt dig et svar, men nu ser jeg har det har jeg ikke.
Undskyld !

Jeg giver dig pointen for løsningen selv om makroen virker ikke  helt.

VED "=LOPSLAG(D1;Ark3!$B$1:$B$5;2;FALSK)"
findes kun $B$1:$B$5. D1 bliver ikke fundet

Årsagen er at antalKol i makroen kun er 1.

Har du en kommentar - eller skal jeg oprette et nyt spørgsmål ?

Tak for hjælpen Koppelgaard