In der Regel ist es offensichtlich wenn eine Formel einen Fehler enthält da dieser auf der Wert-Seite mit #BEZUG! dargestellt wird. Sollte es aber eine Arbeitsmappe mit vielen Tabelle und darin etlichen Formeln / Verweisen sein kann schon mal eine übersehen werden.

Der erste Schritt ist immer per STRG-R nach "#BEZUG!" suchen. Danach muss die Formel neu erstellt / verbessert werden. Wenn aber in der Datenüberprüfung ein Bezugs-Fehler ist wird über die einfache Suche der Fehler nicht gefunden. Hier kommt das VBA-Script zum Einsatz.

Einfach den VBA-Editor öffen ( ALT-F11) und folgenden Code dort in ein neues Modul einfügen (ALT-E ALT-M).
Vorab den Direktbereich anzeigen lassen (STRG-D). Da dort das Ergebnis ausgegeben wird.
Cursor in die Sub setzen und per F5 die Sub starten. Wird jetzt fehlerhafter Bezug gefunden wird die betroffenen Tabelle samt Felder ausgedruckt.

 

Sub Find_REF_Error()
  Dim oWB As Workbook, oWSs As Worksheets, oWS As Worksheet, oCell As Object, oO As Object
  Dim i%, j%, r%, c%, rMax%, cMax%, sValidationExternalLink$, sExternalLink$, sFormatConditions$, sNames$, s$

  ' #BEZUG! Fehler finden (#REF!)
  
  ' Felder finden mit Fehler
  Const cfExternalLink = True

  ' Externe Links mit Fehler
  Const cfValidationExternalLink = True
  ' Wenn etwas gefunden wird den Befehl "Ungültige Daten einkreisen" ausführen.
  ' Es werden aber nicht immer alle fehlerhaften Felder markiert. Die Formel =#BEZUG! wird nicht markiert.
  ' Markierung wieder löschen: Register Daten > Bereich Datentools > Datenüberprüfung > Gültigkeitskreise löschen
  Const cfHiglightFields = True
  
  
  ' Bedinge Formatierungen mit Fehler
  Const cfFormatConditions = True
  
  ' Namen (Feldbezeichnung) im Names-Manager
  Const cfNames = True
  
  
  Application.ScreenUpdating = False
  Application.Visible = False
  
  
  On Error Resume Next
  Set oWB = ActiveWorkbook
  For Each oWS In oWB.Worksheets
    With oWS
      .Select
      ' Die Zelle markieren welche den äußersten Rand des Zellbereichs markiert mit veränderten Zellen
      ActiveCell.SpecialCells(xlLastCell).Select
      
      rMax = ActiveCell.Row
      cMax = ActiveCell.Column
       
      For r = 1 To rMax
        For c = 1 To cMax
          Set oCell = oWS.Cells(r, c)
          
          With oCell
             If cfExternalLink Then
               s = .Formula
               If s <> "" Then
                If InStr(1, s, "#BEZUG!", vbTextCompare) Or InStr(1, s, "#REF!", vbTextCompare) Then
                  sExternalLink = sExternalLink & Replace(oCell.Address(True, False), "$", vbNullString, , 1, vbTextCompare) & "|"
                End If
              End If
            End If
            
            If cfValidationExternalLink Then
              s = vbNullString
              s = .Validation.Formula1
              If s <> vbNullString Then
                If InStr(1, s, "#BEZUG!", vbTextCompare) Or InStr(1, s, "#REF!", vbTextCompare) Then
                  sValidationExternalLink = sValidationExternalLink & Replace(oCell.Address(True, False), "$", vbNullString, , 1, vbTextCompare) & "|"
                End If
              End If
              s = vbNullString
              s = .Validation.Formula2
              If s <> vbNullString Then
                If InStr(1, s, "#BEZUG!", vbTextCompare) Or InStr(1, s, "#REF!", vbTextCompare) Then
                  sValidationExternalLink = sValidationExternalLink & Replace(oCell.Address(True, False), "$", vbNullString, , 1, vbTextCompare) & "|"
                End If
              End If
            End If
          
            If cfFormatConditions Then
              j = .FormatConditions.Count
              For i = 1 To j
                Set oO = .FormatConditions.Item(i)
                s = vbNullString
                s = oO.Formula1
                If InStr(1, s, "#BEZUG!", vbTextCompare) Or InStr(1, s, "#REF!", vbTextCompare) Then
                  sFormatConditions = sFormatConditions & Replace(.Address(True, False), "$", vbNullString, , 1, vbTextCompare) & "|"
                  Exit For
                End If
                s = vbNullString
                s = oO.Formula2
                If InStr(1, s, "#BEZUG!", vbTextCompare) Or InStr(1, s, "#REF!", vbTextCompare) Then
                  sFormatConditions = sFormatConditions & Replace(.Address(True, False), "$", vbNullString, , 1, vbTextCompare) & "|"
                  Exit For
                End If
              Next
            End If
          
          End With
        Next
        
      Next
      
      If sExternalLink <> vbNullString Then
        Debug.Print vbCrLf & "#BEZUG!/#REF! Fehler in folgenden Zellen der Tabelle '" & oWS.Name & "' gefunden."
        Debug.Print Left(sExternalLink, Len(sExternalLink) - 1)
        sExternalLink = vbNullString
      End If
      
      If sValidationExternalLink <> vbNullString Then
        Debug.Print vbCrLf & "#BEZUG!/#REF! Fehler in der Datenüberprüfung folgender Zellen der Tabelle '" & oWS.Name & "' gefunden. " & IIf(cfHiglightFields, "Zellen wurden rot umkreist!", vbNullString)
        Debug.Print Left(sValidationExternalLink, Len(sValidationExternalLink) - 1)
        sValidationExternalLink = vbNullString
        If cfHiglightFields Then ActiveSheet.CircleInvalid
      End If
      
      If sFormatConditions <> vbNullString Then
        Debug.Print vbCrLf & "#BEZUG!/#REF! Fehler in bedinger Formatierung folgender Zellen der Tabelle '" & oWS.Name & "' gefunden. " & IIf(cfHiglightFields, "Zellen wurden rot umkreist!", vbNullString)
        Debug.Print Left(sFormatConditions, Len(sFormatConditions) - 1)
        sFormatConditions = vbNullString
      End If
      
      
    End With
  Next
  
  If cfNames Then
    With oWB
      j = .Names.Count
      For i = 1 To j
        Set oO = .Names.Item(i)
        s = vbNullString
        s = oO.Value
        If InStr(1, s, "#BEZUG!", vbTextCompare) Or InStr(1, s, "#REF!", vbTextCompare) Then
          sNames = sNames & oO.Name & "|"
        End If
      Next
    End With
      
    If sNames <> vbNullString Then
      Debug.Print vbCrLf & "#BEZUG!/#REF! Fehler in benannte Zellen / -Zellbreiche gefunden (Names-Manager)"
      Debug.Print Left(sNames, Len(sNames) - 1)
    End If
  End If
  
  Set oCell = Nothing
  Set oWB = Nothing
  Application.Visible = True
  Application.ScreenUpdating = True
End Sub

 

Wir nutzen Cookies auf unserer Website. Einige von ihnen sind essenziell für den Betrieb der Seite, während andere uns helfen, diese Website und die Nutzererfahrung zu verbessern (Tracking Cookies). Sie können selbst entscheiden, ob Sie die Cookies zulassen möchten. Bitte beachten Sie, dass bei einer Ablehnung womöglich nicht mehr alle Funktionalitäten der Seite zur Verfügung stehen.