AW: Deine Frage kann definitiv mit JA beant...
07.12.2006 16:36:04
fcs
Hallo Paul,
ich frag mich zwar wozu man so etwas braucht, aber des Menschen Wille ist sein Himmelreich.
Hier eine Möglichkeit.
Die Prozedur stellt den Rahmen bereit mit den Funktionen
-Tabellen nacheinander abarbeiten,
-Dateiname der Textdatei festlegen
-Die Zellen im jeweiligen Blatt abarbeiten
-Ergebnis in die Textdatei schreiben
Die Function führt die eigentliche Formelanalyse durch.
Das Ganze muss du noch an deine Bedürfnisse anpassen. In meinem Beispiel werden alle Zellen ausgewertet, die in der Formel den Tabellennamen "Tabelle 1" und die Funktion "ABRUNDEN" enthalten
Gruß
Franz
Sub WerteInTabelle1finden()
Dim wks1 As Worksheet, wks2 As Worksheet, wb As Workbook
Dim Zeile As Long, Spalte As Integer
Dim TextDatei As String, Zelle1 As String, Zelle2 As String, Wert1 As Variant
Set wb = ActiveWorkbook
Set wks1 = wb.Worksheets("Tabelle 1") 'Tabelle auf die in Formeln verwiesen wird
For Each wks2 In wb.Worksheets
If wks2.Name <> wks1.Name Then
'Dateiname der Textdatei generieren
TextDatei = Left(wb.FullName, Len(wb.FullName) - 4) & "_" & wks2.Name & ".txt"
Open TextDatei For Output As #1
For Zeile = 1 To wks2.UsedRange.Row + wks2.UsedRange.Rows.Count - 1
For Spalte = 1 To wks2.UsedRange.Column + wks2.UsedRange.Columns.Count - 1
If wks2.Cells(Zeile, Spalte).HasFormula Then
Zelle1 = FormelAnalyse(wks1.Name, wks2.Cells(Zeile, Spalte).FormulaLocal, "ABRUNDEN")
If Zelle1 <> "" Then
Zelle2 = wks2.Cells(Zeile, Spalte).Address
Wert1 = wks1.Range(Zelle1).Value
'schreibt Daten kommagetrennt in Textfile, so dass mit Input #1, Var1,Var2, Var3 Daten wieder eingelesen werden könnte
'Write #1, Zelle2, Zelle1, Wert1
'schreibt Daten semikolongetrennt zeilenweise in Textfile
Print #1, Zelle2 & ";" & Zelle1 & ";" & Wert1
End If
End If
Next Spalte
Next Zeile
Close #1
End If
Next wks2
End Sub
Private Function FormelAnalyse(Tabelle As String, Formel As String, Optional FormelTeil As String = "") As String
'Tabelle = Name der Tabelle die in der Formel gesucht wird
'Formel = Formel in der auszuwertenden Zelle
'FormelTeil = optionaler Formeltext, der in der Formel auch enthalten sein soll
Dim FormelAuswerten As Boolean
If InStr(1, Formel, Tabelle) > 0 Then
FormelAuswerten = False
If FormelTeil <> "" Then
If InStr(1, Formel, FormelTeil) > 0 Then
FormelAuswerten = True
End If
Else
FormelAuswerten = True
End If
If FormelAuswerten = True Then
'Funktionen für die Formelanalyse sind jeweils individuell anzupassen
FormelAnalyse = Trim(Mid(Formel, InStr(InStr(1, Formel, Tabelle), Formel, "!") + 1, InStr(InStr(1, Formel, Tabelle), Formel, "*") - InStr(InStr(1, Formel, Tabelle), Formel, "!") - 1))
End If
End If
End Function