AW: Namen mit #Bezug! in Excel-Mappe finden
11.05.2012 19:30:02
fcs
Hallo Peter,
nachfolgendes Makro gibt die betroffenen Zellen in einer Liste in einer neuen Arbeitsmappe aus.
Bei ähnlichen Namen (z.B. Name1 und Name10) werden die Zellen mit Name10 leider auf für Name1 gelistet. Das ließe sich aber nur mit einer aufwendigen Formelanlyse vermeiden.
Gruß
Franz
'Makro in einem allgemeinen Modul
Sub Namen_mit_Bezugfehler_finden()
Dim objName As Name, wbAktiv As Workbook, wbZiel As Workbook, wksZiel As Worksheet
Dim Zelle As Range, wks As Worksheet
Dim lngZei As Long, strRefersto As String
Dim iCount As Integer, intI As Integer, CalcStatus As Long
On Error GoTo Fehler
Set wbAktiv = ActiveWorkbook
With Application
.ScreenUpdating = False
.EnableEvents = False
CalcStatus = .Calculation
.Calculation = xlCalculationManual
End With
'Neue Arbeitsmappe anlegen für Ausgabe der Zellen mit Namen mit Bezugsfehler
Set wbZiel = Workbooks.Add(Template:=xlWBATWorksheet)
Set wksZiel = wbZiel.Worksheets(1)
With wksZiel
'Kopfzeilen und Spaltentitel eintragen
lngZei = lngZei + 1
.Cells(lngZei, 1).Value = "Namen mit Fehler #BEZUG in Datei"
lngZei = lngZei + 1
.Cells(lngZei, 1).Value = wbAktiv.Name
'Spaltentitel
lngZei = lngZei + 1
.Cells(lngZei, 1).Value = "Tabelle"
.Cells(lngZei, 2).Value = "Index"
.Cells(lngZei, 3).Value = "Zelle"
.Cells(lngZei, 4).Value = "Zeile"
.Cells(lngZei, 5).Value = "Spalte"
.Cells(lngZei, 6).Value = "Formel"
.Cells(lngZei, 7).Value = "Name"
.Cells(lngZei, 8).Value = "Refers to Local"
Cells(lngZei + 1, 2).Select
Application.ActiveWindow.FreezePanes = True
For Each objName In wbAktiv.Names
iCount = iCount + 1
Application.StatusBar = "Bearbeite Name: " & objName.Name & " (" & iCount & " von " & _
wbAktiv.Names.Count
strRefersto = objName.RefersToLocal
If InStr(1, strRefersto, "#BEZUG") > 0 Then
intI = 0
For Each wks In wbAktiv.Worksheets
intI = intI + 1
Set Zelle = wks.Cells.SpecialCells(xlCellTypeFormulas, 16)
If Not Zelle Is Nothing Then
For Each Zelle In wks.Cells.SpecialCells(xlCellTypeFormulas)
If InStr(1, Zelle.Formula, objName.Name) > 0 Then
lngZei = lngZei + 1
.Cells(lngZei, 1).Value = "'" & wks.Name
.Cells(lngZei, 2).Value = intI
.Cells(lngZei, 3).Value = VBA.Replace(Zelle.Address, "$", "")
.Cells(lngZei, 4).Value = Zelle.Row
.Cells(lngZei, 5).Value = Zelle.Column
.Cells(lngZei, 6).Value = "'" & Zelle.FormulaLocal
.Cells(lngZei, 7).Value = objName.Name
.Cells(lngZei, 8).Value = "'" & objName.RefersToLocal
End If
If lngZei = .Rows.Count Then
MsgBox "Zieltabelle ist voll!", vbInformation + vbOKOnly, "Namen mit #BEZUG _
finden"
GoTo Formatieren
End If
Next
End If
NextWks:
Next
End If
Next
Formatieren:
.Cells.VerticalAlignment = xlTop
.Range(.Columns(1), Columns(8)).AutoFit
With Columns(6)
If .ColumnWidth > 80 Then
.ColumnWidth = 80
.WrapText = True
End If
End With
'Sortieren nach Tabellenname, Zeile, Spalte
With .Range(.Cells(3, 1), .Cells(lngZei, 8))
.Sort key1:=.Range("A1"), Order1:=xlAscending, _
key2:=.Range("D1"), Order2:=xlAscending, _
key3:=.Range("E1"), order3:=xlAscending, Header:=xlYes
End With
End With
Fehler:
With Err
Select Case .Number
Case 0
'alles OK
Case 1004
'keine Formeln im Tabellenblatt gefunden
Resume NextWks
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcStatus
.StatusBar = False
End With
Set objName = Nothing: Set wbAktiv = Nothing: Set wbZiel = Nothing: Set wksZiel = Nothing
Set Zelle = Nothing: Set wks = Nothing
End Sub