![]() |
Betrifft: Formeln auslesen
von: Sparrow
Geschrieben am: 21.10.2014 12:23:34
Hallo!
Ich würde gerne jegliche Formeln, welche in der kompletten Mappe benutzt worden sind, auslesen und auf ein neues Tabellenblatt untereinander niederschreiben - gibt es dazu eine VBA-Lösung?
Vielen Dank im Voraus!
Beste Grüße
Sascha
![]() ![]() |
Betrifft: AW: Formeln auslesen
von: Daniel
Geschrieben am: 21.10.2014 12:47:01
HI
in der einfachsten Form so:
Sub Formeln() Dim sh As Worksheet Dim shFo As Worksheet Dim Bereich As Range Dim Zelle As Range Dim i As Long On Error Resume Next Set shFo = ActiveWorkbook.Sheets("Formelsicherung") On Error GoTo 0 If shFo Is Nothing Then Set shFo = Sheets.Add(after:=ActiveWorkbook.Sheets(ActiveWorkbook.Sheets.Count)) shFo.Name = "Formelsicherung" Else shFo.Cells.ClearContents End If i = 0 For Each sh In ActiveWorkbook.Worksheets If sh.Name <> shFo.Name Then Set Bereich = Nothing On Error Resume Next Set Bereich = sh.UsedRange.SpecialCells(xlCellTypeFormulas) On Error GoTo 0 If Not Bereich Is Nothing Then For Each Zelle In Bereich i = i + 1 shFo.Cells(i, 1).Value = sh.Name shFo.Cells(i, 2).Value = Zelle.Address(0, 0) shFo.Cells(i, 3).Value = "'" & Zelle.FormulaLocal Next End If End If Next End Sub
![]() ![]() |
Betrifft: AW: Formeln auslesen
von: Sparrow
Geschrieben am: 21.10.2014 13:01:28
Hammermäßig, Vielen Dank!
Beste Grüße
Sascha
![]() ![]() |
Betrifft: AW: Formeln auslesen
von: Rudi Maintaire
Geschrieben am: 21.10.2014 12:47:30
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
![]() ![]() |
Betrifft: AW: Formeln auslesen
von: Sparrow
Geschrieben am: 21.10.2014 13:01:08
Hammermäßig, Vielen Dank!
Beste Grüße
Sascha
![]() |