Sub ExtractHyperlinks()
    Dim ws As Worksheet
    Dim cell As Range
    Dim hyperlinkAddress As String
    
    Set ws = ActiveSheet
    
    For Each cell In ws.UsedRange
        If cell.HasFormula Then
            If InStr(cell.formula, "HYPERLINK") > 0 Then
                hyperlinkAddress = Evaluate(Mid(cell.formula, InStr(cell.formula, "(") + 1, InStr(cell.formula, ",") - InStr(cell.formula, "(") - 1))
                cell.Offset(0, 1).Value = hyperlinkAddress
            End If
        ElseIf cell.Hyperlinks.Count > 0 Then
            hyperlinkAddress = cell.Hyperlinks(1).Address
            cell.Offset(0, 1).Value = hyperlinkAddress
        End If
    Next cell
    MsgBox "提取完成", , "逗号技巧"
End Sub