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
Nhận xét
Đăng nhận xét