簡體   English   中英

Excel VBA 獲取特定單元格的超鏈接地址

[英]Excel VBA Get hyperlink address of specific cell

如何編寫 Excel VBA 代碼以檢索特定單元格中超鏈接的 url/地址?

我正在處理我的工作簿的 sheet2,它包含大約 300 行。 每行在“AD”列都有一個唯一的超鏈接。 我想要的是循環“J”列中的每個空白單元格,並將其值從空白更改為“AD”列單元格的超鏈接 URL。 我目前正在使用此代碼:

do while....
    NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address
    On Error Resume Next
    GetAddress = Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks(1).Address
    On Error GoTo 0
loop

上面代碼的問題是它總是獲取第一個超鏈接的地址,因為代碼是.Hyperlinks(1).Address 無論如何可以通過范圍地址獲取超鏈接地址,例如sheet1.range("AD32").Hyperlinks.Address

這應該有效:

Dim r As Long, h As Hyperlink
For r = 1 To Range("AD1").End(xlDown).Row
    For Each h In ActiveSheet.Hyperlinks
        If Cells(r, "AD").Address = h.Range.Address Then
            Cells(r, "J") = h.Address
        End If
    Next h
Next r

這有點令人困惑,因為 Range.Address 與 Hyperlink.Address(這是您的 URL)完全不同,聲明您的類型會有很大幫助。 這是將“Option Explicit”放在模塊頂部會有所幫助的另一種情況。

不知道為什么我們做大事,代碼很簡單

Sub ExtractURL()
    Dim GetURL As String
    For i = 3 To 500
        If IsEmpty(Cells(i, 1)) = False Then
            Sheets("Sheet2").Range("D" & i).Value = 
               Sheets("Sheet2").Range("A" & i).Hyperlinks(1).Address
        End If
    Next i
End Sub

我從評論中了解到您已經將列 J 設置為 URL 字符串。 如果是這樣,這個簡單的腳本應該可以完成這項工作(它將單元格超鏈接到單元格內指定的地址,如果您願意,可以通過更改 textToDisplay 選項來更改單元格文本)。 如果我誤解了這一點並且字符串在 AD 列中,只需計算 AD 的列號並替換以下行:

fileLink = Cells(i, the number of column AD)

劇本:

Sub AddHyperlink()

Dim fileLink As String

Application.ScreenUpdating = False

With ActiveSheet
lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row


For i = 4 To lastrow

    fileLink = Cells(i, 10)

    .Hyperlinks.Add Anchor:=Cells(i, 10), _
    Address:=fileLink, _
    TextToDisplay:=fileLink

Next i

End With

Application.ScreenUpdating = True

End Sub

嘗試為每個循環運行如下:

do while....
    NextToFill = Sheet2.Range("J1").End(xlDown).Offset(1).Address
    On Error Resume Next
    **for each** lnk in Sheet2.Range("AD" & Sheet2.Range(NextToFill).Row).Hyperlinks
         GetAddress=lnk.Address
    next
On Error GoTo 0
loop

這個 IMO 應該是一個函數來返回這樣的字符串。

Public Sub TestHyperLink()
 Dim CellRng As Range
 Set CellRng = Range("B3")
 
 Dim HyperLinkURLStr As String
 HyperLinkURLStr = HyperLinkURLFromCell(CellRng)
 Debug.Print HyperLinkURLStr
End Sub

Public Function HyperLinkURLFromCell(CellRng As Range) As String
 HyperLinkURLFromCell = CStr(CellRng.Hyperlinks(1).Address)
End Function

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM