VBA-excel : Trích xuất danh sách công thức liên kết (Formula Links) ra một Sheet riêng

1. Bài toán thực tế

Khi nhận được một File Excel quá lớn với hàng trăm công thức, việc kiểm tra xem ô nào đang liên kết đi đâu (sang Sheet khác hoặc File khác) là một cực hình,đoạn code này sẽ giúp bạn liệt kê các ô chứa công thức liên kết ra một bảng tổng hợp.

 template

Sub GetFormulaLinks()

    Dim ws As Worksheet

    Dim formulaLinks As Variant

    Dim rowIndex As Long

    Dim outputSheet As Worksheet

    Dim sheetName As String

    ' Prompt the user to enter the sheet name

    sheetName = InputBox("Enter the sheet name:")

    ' Check if the sheet name is valid

    On Error Resume Next

    Set ws = ActiveWorkbook.Sheets(sheetName)

    On Error GoTo 0

    ' If the sheet name is invalid, display an error message and exit the macro

    If ws Is Nothing Then

        MsgBox "Invalid sheet name. Please try again.", vbExclamation

        Exit Sub

    End If

    ' Create a new Excel sheet to store the results

    Set outputSheet = ActiveWorkbook.Sheets.Add

    ' Set the headers for the result table

    outputSheet.Range("A1").Value = "Cell"

    outputSheet.Range("B1").Value = "Formula Link"

    ' Set the starting row for writing formula links in the result table

    rowIndex = 2

    ' Get the array of formula links from the specified worksheet

    formulaLinks = ws.UsedRange.formula

    ' Loop through each cell in the array and write formula link information to the result table

    For i = 1 To UBound(formulaLinks, 1)

        For j = 1 To UBound(formulaLinks, 2)

            ' Check if the cell contains a formula and has a link

            If Left(formulaLinks(i, j), 1) = "=" And InStr(formulaLinks(i, j), "!") > 0 Then

                ' Write the cell address and formula link to the result table

                outputSheet.Cells(rowIndex, 1).Value = ws.Cells(i, j).Address(False, False)

                outputSheet.Cells(rowIndex, 2).Value = formulaLinks(i, j)

                ' Increment the row index in the result table

                rowIndex = rowIndex + 1

            End If

        Next j

    Next i

    ' Autofit the columns in the result table to fit the content

    outputSheet.Columns.AutoFit

End Sub