Mit den folgenden Makros können Sie Formeln in Zellen finden und löschen, die auf andere Arbeitsmappen verweisen.

Die Makros finden nicht alle externen Referenzen, da sie nur in den Arbeitsblattformeln angezeigt werden.

Sub DeleteOrListLinks()

Dim i As Integer

If ActiveWorkbook Is Nothing Then Exit Sub

i = MsgBox("YES: Delete external formula references" & Chr(13) & _

"NO: List external formula references", _

vbQuestion + vbYesNoCancel, "Delete or list external formula references")

Select Case i

Case vbYes

DeleteExternalFormulaReferences

Case vbNo

ListExternalFormulaReferences

End Select

End Sub

Sub DeleteExternalFormulaReferences()

Dim ws As Worksheet, AWS As String, ConfirmReplace As Boolean

Dim i As Integer, OK As Boolean

If ActiveWorkbook Is Nothing Then Exit Sub

i = MsgBox("Confirm all replacements of external formula references with values?", _

vbQuestion + vbYesNoCancel, "Convert external formula references")

ConfirmReplace = False

If i = vbCancel Then Exit Sub

If i = vbYes Then ConfirmReplace = True

AWS = ActiveSheet.Name

Application.ScreenUpdating = False

For Each ws In ActiveWorkbook.Worksheets

OK = DeleteLinksInWS(ConfirmReplace, ws)

If Not OK Then Exit For

Next ws

Set ws = Nothing

Sheets(AWS).Select

Application.ScreenUpdating = True

End Sub

Private Function DeleteLinksInWS(ConfirmReplace As Boolean, _

ws As Worksheet) As Boolean

Dim cl As Range, cFormula As String, i As Integer

DeleteLinksInWS = True

If ws Is Nothing Then Exit Function

Application.StatusBar = "Deleting external formula references in " & _

ws.Name & "..."

ws.Activate

For Each cl In ws.UsedRange

cFormula = cl.Formula

If Len(cFormula) > 0 Then

If Left$(cFormula, 1) = "=" Then

If InStr(cFormula, "[") > 1 Then

If Not ConfirmReplace Then

cl.Formula = cl.Value

Else

Application.ScreenUpdating = True

cl.Select

i = MsgBox("Replace the formula with the value?", _

vbQuestion + vbYesNoCancel, _

"Replace external formula reference in " & _

cl.Address(False, False, xlA1) & _

" with the cell value?")

Application.ScreenUpdating = False

If i = vbCancel Then

DeleteLinksInWS = False

Exit Function

End If

If i = vbYes Then

On Error Resume Next

' in case the worksheet is protected

cl.Formula = cl.Value

On Error GoTo 0

End If

End If

End If

End If

End If

Next cl

Set cl = Nothing

Application.StatusBar = False

End Function

Sub ListExternalFormulaReferences()

Dim ws As Worksheet, TargetWS As Worksheet, SourceWB As Workbook

If ActiveWorkbook Is Nothing Then Exit Sub

Application.ScreenUpdating = False

With ActiveWorkbook

On Error Resume Next

Set TargetWS = .Worksheets.Add(Before:=.Worksheets(1))

If TargetWS Is Nothing Then ' the workbook is protected

Set SourceWB = ActiveWorkbook

Set TargetWS = Workbooks.Add.Worksheets(1)

SourceWB.Activate

Set SourceWB = Nothing

End If

With TargetWS

.Range("A1").Formula = "Sequence"

.Range("B1").Formula = "Cell"

.Range("C1").Formula = "Formula"

.Range("A1:C1").Font.Bold = True

End With

For Each ws In .Worksheets

If Not ws Is TargetWS Then

ListLinksInWS ws, TargetWS

End If

Next ws

Set ws = Nothing

End With

With TargetWS

.Parent.Activate

.Activate

.Columns("A:C").AutoFit

On Error Resume Next

.Name = "Link List"

On Error GoTo 0

End With

Set TargetWS = Nothing

Application.ScreenUpdating = True

End Sub

Private Sub ListLinksInWS(ws As Worksheet, TargetWS As Worksheet)

Dim cl As Range, cFormula As String, tRow As Long

If ws Is Nothing Then Exit Sub

If TargetWS Is Nothing Then Exit Sub

Application.StatusBar = "Finding external formula references in " & _

ws.Name & "..."

For Each cl In ws.UsedRange

cFormula = cl.Formula

If Len(cFormula) > 0 Then

If Left$(cFormula, 1) = "=" Then

If InStr(cFormula, "[") > 1 Then

With TargetWS

tRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1

.Range("A" & tRow).Formula = tRow - 1

.Range("B" & tRow).Formula = ws.Name & "!" & _

cl.Address(False, False, xlA1)

.Range("C" & tRow).Formula = "'" & cFormula

End With

End If

End If

End If

Next cl

Set cl = Nothing

Application.StatusBar = False

End Sub