Option Explicit
'Code Peter Haserodt 2005

' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'Vorbemerkung
'DieseArbeitsmappe benötigt:
'Tabellenblatt funk in welchem beginnend in A1 die Funktionen nach unten aufgelistet sind (kannn man aus VBAliste.xls holen)
'Tabellenblatt output -> dort wird ausgegeben, kann man anpassen
' !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
Dim fFormelFeld As Variant
Dim oSuchRange As Range, sFormlString As String
Dim iAnz As Integer
Public Sub HolDieFormeln()
'Code Peter Haserodt 2005
 Dim oZiel As Worksheet, iFormelCount As Long
 Dim s As String, iCount As Byte, k As Long, iZeitCount As Long, oRa As Range
 Dim oFormelRange As Range, oQuellMappe As Workbook, g As Worksheet
 Redim fFormelFeld(400) ' Nur so, sollte reichen, gegebenenfalls erhöhen
 sFormlString = "|"
 iAnz = 0
 iFormelCount = 0

 Set oZiel = ThisWorkbook.Sheets("output")
 Set oQuellMappe = ActiveWorkbook ' Entsprechend Anpassen
 Set oSuchRange = ThisWorkbook.Sheets("funk").Range("A1").CurrentRegion
 For Each g In oQuellMappe.Worksheets
 On Error Resume Next
 Set oFormelRange = g.Cells.SpecialCells(xlCellTypeFormulas)
 On Error GoTo 0
 If Not oFormelRange Is Nothing Then
 For Each oRa In oFormelRange
 iFormelCount = iFormelCount + 1
 FuncInFormel oRa.FormulaLocal
 Next oRa
 End If
 Set oFormelRange = Nothing
 Next g
  
 oZiel.Cells.Clear
 oZiel.Range("a1:a401").Value = WorksheetFunction.Transpose(fFormelFeld) ' Lazy
 oZiel.Range("a1").Value = oQuellMappe.Name
 End Sub
Private Function FuncInFormel(DieFormel As String)
'Code Peter Haserodt 2005
 Dim i As Integer, bHoch As Boolean, iKlammer As Integer, sMid As String
 
 Dim sZ As String, sOut As String
 
 For i = Len(DieFormel) To 1 Step -1
  sZ = Mid(DieFormel, i, 1)
  If sZ = """" Then
   If bHoch Then
   bHoch = False
   Else
   bHoch = True
   
   End If
   
  Else ' Nich bh
   If Not bHoch Then
   If iKlammer > 0 Then
    Select Case Asc(LCase(sZ))
     Case 48 To 57, 97 To 122, 246, 252, 228, 223
     Case Else
      sMid = Mid(DieFormel, i + 1, iKlammer - i - 1)
      If InStr(1, sFormlString, "|" & sMid & "|", vbTextCompare) = 0 Then
      If Not (oSuchRange.Find(sMid, lookat:=xlWhole) Is Nothing) Then
      sFormlString = sFormlString & sMid & "|"
      iAnz = iAnz + 1
      fFormelFeld(iAnz) = sMid
      End If
     End If
      iKlammer = 0
      If sZ = "(" Then iKlammer = i
    End Select
   Else
    If sZ = "(" Then
     Select Case Asc(LCase(Mid(DieFormel, i - 1, 1)))
      Case 48 To 57, 97 To 122, 246, 252, 228, 223
      iKlammer = i
     End Select
     
     
    End If
   End If
   End If
  End If
 Next i
 End Function