Cu macro-urile de mai jos puteți găsi și șterge formule din celule care se referă la alte registre de lucru.
Macrocomenzile nu găsesc toate referințele externe, deoarece se uită doar în formulele foii de lucru.
Sub DeleteOrListLinks () Dim i Integer If ActiveWorkbook is Nothing then Exit Sub i = MsgBox ("DA: Șterge referințele formulei externe" & Chr (13) & _ "NU: Listează referințele formulei externe", _ vbQuestion + vbYesNoCancel, "Șterge sau listați referințele formulei externe ") Selectați Case i Case vbDa Delete DeleteExternalFormulaReferences Case vbNo ListExternalFormulaReferences End Select End End Sub Sub DeleteExternalFormulaReferences () Dim ws Ca foaie de lucru, AWS As String, ConfirmReplace As Boolean Dim i As Integer, OK As Boolean Nothing Active Sub i = MsgBox („Confirmați toate înlocuirile referințelor formulei externe cu valori?”, _ VbQuestion + vbYesNoCancel, „Convertiți referințele formulei externe”) ConfirmReplace = False If i = vbCancel Then Exit Sub If i = vbYes Then ConfirmReplace = True AWS = ActiveSheet.Name Application.ScreenUpdating = Fals pentru fiecare ws din ActiveWorkbook.Worksheets OK = DeleteLinksInWS (ConfirmReplace, ws) Dacă nu este OK, apoi ieșiți pentru următorul ws Set ws = Nothing Sheets (A WS) .Select Application.ScreenUpdating = True End Sub Function Private DeleteLinksInWS (ConfirmReplace As Boolean, _ ws As Worksheet) As Boolean Dim cl As Range, cFormula As String, i As Integer DeleteLinksInWS = True Dacă ws is Nothing Apoi funcția de ieșire. StatusBar = "Ștergerea referințelor formulei externe din" & _ ws.Name & "…" ws.Activați pentru fiecare cl In ws.UsedRange cFormula = cl.Formula If Len (cFormula)> 0 Atunci Dacă este lăsat $ (cFormula, 1) = "=" Then If InStr (cFormula, "[")> 1 Then If Not ConfirmReplace Then cl.Formula = cl.Value Else Application.ScreenUpdating = True cl.Select i = MsgBox ("Înlocuiți formula cu valoarea?", _ vbQuestion + vbYesNoCancel, _ "Înlocuiește referința formulei externe în" & _ cl.Address (False, False, xlA1) & _ "cu valoarea celulei?") Application.ScreenUpdating = False If i = vbCancel Then DeleteLinksInWS = False Exit Function Închideți dacă dacă i = vb Da, atunci la eroare Reîncepeți următoarea 'în cazul în care foaia de lucru este protejată cl.Formulă = cl.Valoare la eroare GoTo 0 Încheieți dacă E nd If End If End If End If Next cl Set cl = Nothing Application.StatusBar = False End Function Sub ListExternalFormulaReferences () Dim ws Ca foaie de lucru, TargetWS ca foaie de lucru, SourceWB Ca registru de lucru Dacă ActiveWorkbook nu este nimic, ieșiți din Sub Application.ScreenUpdating = Fals cu ActiveWorkbook On Error Reîncepeți următorul Set TargetWS = .Worksheets.Add (Înainte: =. Foi de lucru (1)) Dacă TargetWS nu este nimic, atunci „registrul de lucru este protejat 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 = Adevărat sfârșit cu pentru fiecare ws din. Foi de lucru dacă nu ws este TargetWS, apoi 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 At Long If ws is Nothing, Exit Sub If TargetWS Is Nothing Then Exit Sub Application.StatusBar = "Finding external referințe de formulă în "& _ ws.Name &" … "Pentru fiecare cl In ws.UsedRange cFormula = cl.Formula If Len (cFormula)> 0 Then If Left $ (cFormula, 1) =" = "Then If InStr (cFormula , "[")> 1 Apoi cu 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 End If Next cl Set cl = Nothing Application.StatusBar = False End Sub