2017-03-22 14 views
1

Ich möchte rekursiv in einer Formel eines Bereichsobjekts suchen, bis ich jeden einzelnen Wert finde, aus dem es zusammengesetzt ist. Da ich mir über die grammatikalische Korrektheit des vorherigen Satzes nicht ganz sicher bin (jedenfalls entschuldige ich mich für mein Englisch) werde ich versuchen zu erklären, was ich mit einem Beispiel erreichen möchte (in der Hoffnung, dass dies die einfachste sein könnte) :Werte aus Formel in VBA rekursiv extrahieren

mysheet = "Sheet1" 
    Sheets(mysheet).Range("A1").Formula = "=+B1" 
    Sheets(mysheet).Range("B1").Formula = "=+C1-C2" 
    Sheets(mysheet).Range("C1").Value = "value:val1" 
    Sheets(mysheet).Range("C2").Formula = "=+D1-D2" 
    Sheets(mysheet).Range("D1").Value = "value:val2" 
    Sheets(mysheet).Range("D2").Value = "value:val3" 

können Sie mir einen Hinweis (oder besser einen Entwurf von Code) geben an, welche Art von Funktion (? eine rekursive ein, vielleicht) einen String zurückgeben kann (nennen wir es my_formula), so dass der Befehl

MsgBox(my_formula) 

kehrt die folgende:

A1 = +value:val1 - value:val2 + value:val3 

? Bitte helfen Sie mir

Danke

Update nach weniger als einer Stunde

Hallo an alle und vielen Dank für Ihre Antworten. Ich würde darauf hinweisen, dass die Werte in Zellen effektiv Zeichenfolgen sind + Ich habe nur einfache Operationen (+ und -) + Alle Abhängigkeiten sind im selben Blatt + Ich habe keine Bereiche wie $ X $ 1. Ich kenne jedoch die Methoden/Eigenschaften, die von einigen von Ihnen gepostet wurden (Präzedenzfall, NavigateArrow ...), aber was ich fragte, ist eine Idee, wie man diese Art von Methode/Eigenschaften am besten verwendet, ohne Kopfschmerzen zu bekommen.

Vielen Dank noch einmal

+0

Wenn es keine eingebaute Eigenschaft des Bereichsobjekts gibt, kann ich mir Kopfschmerzen aufgrund von benannten Bereichen, Tabellenreferenzen, Arbeitsbuchverweisen, Verbindungen usw. nur vorstellen. Aber gehen Sie davon aus, dass alle Ihre Zellenwerte nur die sind Form A1 oder $ A $ 1? –

+0

https://msdn.microsoft.com/en-us/library/office/ff197707.aspx vielleicht? –

+1

Husten - meinst du nicht https://msdn.microsoft.com/en-us/library/office/ff196936.aspx –

Antwort

2

Dieser Code wird für Ihr Beispiel arbeiten - aber YMMV, wie es zu komplexeren Formeln im wirklichen Leben skaliert. Es wird Ihnen jedoch helfen - und dann einige - mit, wie Sie über die Precedents Sammlung von Range rekrutieren. Ich habe den Code kommentiert, aber der einfachste Weg, dies zu verstehen, besteht darin, im Debug-Modus mit F8 durchzugehen.

Option Explicit 

Sub Test() 
    Dim ws As Worksheet 
    Dim rng As Range 
    Dim strOutput As String 

    'your test case from the original question  
    Set ws = ThisWorkbook.Sheets("Sheet1") 
    With ws 
     .Range("A1").Formula = "=+B1" 
     .Range("B1").Formula = "=+C1-C2" 
     .Range("C1").Value = "10" 
     .Range("C2").Formula = "=+D1-D2" 
     .Range("D1").Value = "20" 
     .Range("D2").Value = "30" 
    End With 

    'the cell you want to start from 
    Set rng = Sheet1.Range("A1") 

    'get the output from calling the recursive function 
    'note we pass the original formula in to kick off the function 
    strOutput = rng.Address(0, 0) & GetFullFormula(rng, rng.Formula) 

    'show user 
    MsgBox strOutput 

End Sub 

Function GetFullFormula(rng As Range, strFormula As String) As String 

    Dim rngPrecedents As Range 
    Dim rngPrecedent As Range 
    Dim strPrecedentAddress As String 
    Dim strPrecedentFormula As String 

    If rng.HasFormula Then 
     Set rngPrecedents = rng.Precedents 
     For Each rngPrecedent In rngPrecedents 
      'get the precedent cell address to check if in current formula (without $) 
      strPrecedentAddress = rngPrecedent.Address(0, 0) 
      'Debug.Print strFormula 
      'substiute into formula if matching a range address 
      If rngPrecedent.HasFormula Then 
       If InStr(1, strFormula, strPrecedentAddress, vbBinaryCompare) Then 
        'strip = from formula and put in brackets to preserve ordering 
        strPrecedentFormula = "(" & Mid(rngPrecedent.Formula, 2, Len(rngPrecedent.Formula) - 1) & ")" 
        'replace our formula with precedent formula 
        strFormula = Replace(strFormula, strPrecedentAddress, strPrecedentFormula) 
       End If 
       'carry on with recursion - passes formula back into function for expansion 
       GetFullFormula rngPrecedent, strFormula 
      Else 
       'just a value 
       If InStr(1, strFormula, strPrecedentAddress, vbBinaryCompare) Then 
        'replace the address with the value 
        strFormula = Replace(strFormula, strPrecedentAddress, rngPrecedent.Value) 
       End If 
      End If 
     Next rngPrecedent 
    End If 

    GetFullFormula = strFormula 

End Function 

Ausgang:

=+(+10-(+20-30)) 

Es wird ein Problem mit diesem Code, wenn Sie Zellbezüge wie $A$1 verwenden, da die Funktion Klarzellbezüge erwartet. Der Code könnte erweitert werden, um diese Fälle und benannte Bereiche zu behandeln, aber dies ist nur ein einfaches Beispiel.