AW: AW:darf ich leider nicht, dennoch danke! owT
15.12.2008 14:11:00
Rudi
Hallo,
schon älter, aber vielleicht hilft's:
Sub Formeln_suchen_extern()
'Auflistung aller Formeln mit Bezug zu einer anderen Mappe
Dim Wks As Worksheet, wksFormeln As Worksheet
Dim blnIndex As Boolean, rngF As Range, rngFormeln As Range
Dim lngZeile As Long, Kopf
Application.ScreenUpdating = False
blnIndex = False
lngZeile = 2
For Each Wks In ActiveWorkbook.Worksheets
Set rngFormeln = Nothing
On Error Resume Next
Set rngFormeln = Wks.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If rngFormeln Is Nothing Then
Else
For Each rngF In rngFormeln
If InStr(rngF.FormulaLocal, "\[") > 0 Then
If blnIndex = False Then
Set wksFormeln = Worksheets.Add(after:=Sheets(Worksheets.Count))
Kopf = Array("Blatt", "Zelle", "Zeile", "Spalte", "Formel")
With wksFormeln
.Name = "ext.Formeln"
.Range("A1:E1") = Kopf
End With
blnIndex = True
End If
With wksFormeln
.Cells(lngZeile, 1) = Wks.Name
.Cells(lngZeile, 2) = rngF.Address(0, 0)
.Cells(lngZeile, 3) = rngF.Row
.Cells(lngZeile, 4) = rngF.Column
.Cells(lngZeile, 5) = "'" & rngF.FormulaLocal
.Columns.AutoFit
End With
lngZeile = lngZeile + 1
End If
Next rngF
End If
Next Wks
Range("A1").Select
If blnIndex = False Then
MsgBox "Keine externen Bezüge vorhanden.", , ""
Else
wksFormeln.Activate
End If
Application.ScreenUpdating = True
End Sub
Gruß
Rudi