excel VBA宏设置文件中信息的超链接

piv4azn7  于 2023-06-25  发布在  其他
关注(0)|答案(2)|浏览(146)

有一个excel工作簿,其中有许多指向大学网站的超链接,但许多超链接链接到了它们不应该链接的地方,并且由于某种原因经常无法正确更改。已经隔离了所有的网址,他们应该导致在我的工作表范围内,并希望将它们设置为超链接。不能真正使用超链接公式,因为它需要引用单元格和文件需要上传的方式,引用不能存在于所有,所以我试图使用超链接。添加功能在VBA中,但我似乎不能让它改变地址或文本选择的基础上,它目前的链接。曾试图将它们设置为范围,但它们似乎拒绝。是否有可能让它单独检查,然后循环整个范围,即使它的时间消耗?
下面是我试图手动记录并将其循环的代码,但无法找出循环部分。

Sub Hyperlink()

    Selection.Hyperlinks(1).Delete
    Range("G2:G1054").Select
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        Range("S2:S1054"), TextToDisplay:= _
        Range("V2:V1054")

End Sub

作为附加注解,要显示的文本不是唯一的,但它们并不完全相同,地址也是如此。

oug3syen

oug3syen1#

你需要使用一个循环:

Sub Hyperlink()
    Dim ws As Worksheet, c As Range, rngLinks As Range, url, txt
    
    Set ws = ActiveSheet
    Set rngLinks = ws.Range("G2:G1054")
    rngLinks.Hyperlinks.Delete

    For Each c In rngLinks
        url = c.EntireRow.Columns("S").Value
        txt = c.EntireRow.Columns("V").Value
        If Not IsError(url) And Not IsError(txt) Then
            If Len(url) > 0 And Len(txt) > 0 Then
                ws.Hyperlinks.Add Anchor:=c, _
                   Address:=url, TextToDisplay:=txt
            End If  'not empty
        End If      'not error
    Next c

End Sub
5us2dqdw

5us2dqdw2#

看起来您使用的是宏记录器输出的更改版本。这里的问题是ActiveSheet.Hyperlinks.Add一次只处理一个单元格,所以不能给予它一个包含多个单元格的范围。
相反,您需要使用循环。例如:

Sub Hyperlink()

    'Define your workbook variable
    Dim wb As Workbook
    Set wb = ThisWorkbook 'Or use Workbooks("<YourWorkbookName>")
    
    'Define your worksheet variable
    Dim ws As Worksheet
    Set ws = wb.Sheets("Sheet1") 'Replace with your sheet name
    
    'Define your ranges
    Dim DestinationRange As Range
    Set DestinationRange = ws.Range("G2:G1054")
       
    Dim AddressRange As Range
    Set AddressRange = ws.Range("S2:S1054")
    
    Dim TextToDiplayRange As Range
    Set TextToDiplayRange = ws.Range("V2:V1054")
        
    'Apply hyperlinks to one cell at a time.
    Dim i As Long
    For i = 1 To DestinationRange.Cells.Count
           
        ws.Hyperlinks.Add Anchor:=DestinationRange.Cells(i, 1), _
            Address:=AddressRange.Cells(i, 1).Value2, _
            TextToDisplay:=TextToDiplayRange.Cells(i, 1).Value2
            
    Next

End Sub

请注意,如果您无论如何都要覆盖以前的超链接,则不需要删除它们。

相关问题