EXCEL-VBA超链接转换查询

Question

Dim RITMRow As Long
Dim ws1 As Worksheet
Dim RITMstorage As String
Dim LastRow As Long




Set ws1 = Sheets("Tracker")


LastRow = ws1.Range("A" & Rows.Count).End(xlUp).Row

For RITMRow = 2 To LastRow


RITMstorage = ws1.Range("A" & RITMRow).Value



ws1.Range("A" & RITMRow).Hyperlinks.Add Anchor:=ws1.Range("A" & RITMRow), _
    Address:="https://site.site.com/sc_req_item.do?sys_id=" & RITMstorage, _
    ScreenTip:="Request Number", _
    TextToDisplay:=RITMstorage


Next RITMRow


With ws1

.Cells.Font.Size = "8"
.Cells.RowHeight = 11.25
.Cells.Font.Name = "Calibri"
.Range("A1").EntireRow.RowHeight = 25

End With

嗨，我上面的代码可以将列转换为超链接。如您所见，它的效率相当低，因为每次我单击该按钮时，它都会返回并再次将所有内容转换为超链接，即使是那些已经是超链接的链接。请指出正确的方向。我需要一种方法来检测已经有超链接的列，偏移量为 1，然后转换非超链接单元格。

提前致谢。

Answer 1

尝试从单元格中获取地址并检查是否出现错误：

Dim url As String
Dim isLink As Boolean
For RITMRow = 2 To LastRow

    On Error Resume Next
    url = ws1.Range("A" & RITMRow).Hyperlinks(1).SubAddress
    isLink = (Err.Number = 0)
    On Error GoTo 0

    If Not isLink Then
        RITMstorage = ws1.Range("A" & RITMRow).Value
        ws1.Range("A" & RITMRow).Hyperlinks.Add Anchor:=ws1.Range("A" & RITMRow), _
            Address:="https://site.site.com/sc_req_item.do?sys_id=" & RITMstorage, _
            ScreenTip:="Request Number", _
            TextToDisplay:=RITMstorage
    End If

Next RITMRow

EXCEL-VBA超链接转换查询

EXCEL-VBA hyperlinks conversion inquiry

excel

vba

hyperlink