AW: Formeln auslesen
21.10.2014 12:47:30
Rudi
Hallo,
uralt, aber tut's
Sub Formeln_suchen()
Dim strSheetName As String, strFormulaSheet As String
Dim FIndex As Boolean, Wks As Worksheet
Dim strKopf, z As Integer, R1 As Range, A As Range
strKopf = Array("Zelle", "Zeile", "Spalte", "Formel")
Application.ScreenUpdating = False
strSheetName = ActiveSheet.Name
strFormulaSheet = "Formeln_" & strSheetName
For Each Wks In Worksheets
If Wks.Name = strFormulaSheet Then
FIndex = True
Exit For
End If
Next Wks
z = 2
On Error Resume Next
Set R1 = Cells.SpecialCells(xlCellTypeFormulas)
If R1 Is Nothing Then Exit Sub
On Error GoTo 0
If FIndex = False Then
Worksheets.Add after:=Sheets(strSheetName)
ActiveSheet.Name = strFormulaSheet
FIndex = True
Else
Sheets(strFormulaSheet).Cells.Clear
End If
With Sheets(strFormulaSheet)
.Range(.Cells(1, 1), .Cells(1, 4)) = WorksheetFunction.Transpose(WorksheetFunction. _
Transpose(strKopf))
End With
For Each A In R1
With Sheets(strFormulaSheet)
.Cells(z, 1) = A.Address(rowabsolute:=False, columnabsolute:=False)
.Cells(z, 2) = A.Row
.Cells(z, 3) = A.Column
.Cells(z, 4) = "'" & A.FormulaLocal
End With
z = z + 1
Next A
With Sheets(strFormulaSheet)
.Select
.Columns("A:D").EntireColumn.AutoFit
.Range("A1").Select
End With
Application.ScreenUpdating = True
End Sub
Gruß
Rudi