Listen, ändern oder löschen Sie externe Formelreferenzen (Links) mit VBA in Microsoft Excel

Anonim

Mit den folgenden Makros können Sie Formeln in Zellen suchen und löschen, die auf andere Arbeitsmappen verweisen.
Die Makros finden nicht alle externen Referenzen, da sie nur in den Arbeitsblattformeln suchen.

Sub DeleteOrListLinks() Dim i As Integer If ActiveWorkbook Is Nothing Then Exit Sub i = MsgBox("YES: Externe Formelreferenzen löschen" & Chr(13) & _ "NO: Externe Formelreferenzen auflisten", _ vbQuestion + vbYesNoCancel, "Delete oder externe Formelreferenzen auflisten") 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("Alle Ersetzungen externer Formelreferenzen durch Werte bestätigen?", _ vbQuestion + vbYesNoCancel, "Externe Formelreferenzen konvertieren") 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) Wenn nicht OK, dann Exit For Next ws Set ws = Nothing Sheets(A WS).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 Wenn ws nichts ist, dann beenden Sie die Funktionsanwendung. StatusBar = "Löschen externer Formelreferenzen 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("Formel durch den Wert ersetzen?", _ vbQuestion + vbYesNoCancel, _ "Externe Formelreferenz in " & _ cl.Address(False, False, xlA1) & _ " durch den Zellenwert ersetzen?") Application.ScreenUpdating = False If i = vbCancel Then DeleteLinksInWS = False Exit Function End If If i = vbYes Then On Error Resume Next ' falls das Arbeitsblatt geschützt ist cl.Formula = cl.Value On Error GoTo 0 End If E nd If End If End If End If Next cl Set cl = Nothing Application.StatusBar = False End Function Sub ListExternalFormulaReferences() Dim ws als Arbeitsblatt, TargetWS als Arbeitsblatt, SourceWB als Arbeitsmappe Wenn ActiveWorkbook nichts ist, dann Exit Sub Application.ScreenUpdating = False With ActiveWorkbook On Error Resume Next Set TargetWS = .Worksheets.Add(Before:=.Worksheets(1)) If TargetWS Is Nothing Then ' ist die Arbeitsmappe geschützt 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.ScreenUpdati ng = 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 Formelreferenzen 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).Formel = 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