表格之间的Excel VBA超链接功能未激活单元格答案

【问题标题】：Excel VBA Hyperlinks Function Between Sheets not activating cell表格之间的Excel VBA超链接功能未激活单元格
【发布时间】：2018-09-26 22:50:03
【问题描述】：

我正在编写一个带有两张工作表的 Excel 工作簿。在第一张表的 C 列 (Sheet1!C1:C500) 我在每个单元格中都有一个字符串。我编写了以下代码以查找该字符串在工作表 2 的 B 列中出现的位置 (Sheet2!B1:B184)，并将工作表 1 中的单元格转换为指向工作表 2 中相应单元格的超链接。

Sub HypLinks()

    Dim NametoFind As String

    Sheets("Sheet1").Activate

    For Each c In Range(Range("C1"),_
    Range("C1").End(xlDown).End(xlDown).End(xlUp))
        NametoFind = c.Value
        Worksheets("Sheet2").Activate
        Set gg = Range(Range("B1"),_ 
       Range("B1").End(xlDown).End(xlDown).End(xlUp)).Find(NametoFind,_ 
        LookIn:=xlValues)
        Worksheets("Sheet1").Activate
        ActiveSheet.Hyperlinks.Add Range("Sheet1!C" & c.Row),_ 
        Address:="", SubAddress:="#Sheet2!" & gg.Address,_
        TextToDisplay:=c.Value
    Next

End Sub

一切正常，除了当我单击超链接时，它只将我带到 Sheet2，但不会激活 gg.Address 指定的单元格。如果我删除“#Sheet2！” gg.Address 指定的单元格已激活，但在工作表 1 而非工作表 2 中。

【问题讨论】：

标签： excel hyperlink vba

【解决方案1】：

你的问题可以通过改变来解决

Set gg = Range(Range("B1"), _
Range("B1").End(xlDown).End(xlDown).End(xlUp)).Find(NametoFind, _
LookIn:=xlValues)

到

Set gg = Worksheets("Sheet2").Range(Worksheets("Sheet2").Range("B1"), _
Worksheets("Sheet2").Range("B1").End(xlDown).End(xlDown).End(xlUp)).Find(NametoFind, _
LookIn:=xlValues)

那是因为你的细胞还没有完全合格。

话虽如此，但这是一种非常复杂且不可靠的方法。我建议，声明对象、变量，然后使用它们。还要使用错误处理。例如，如果没有找到匹配项，那么 gg.Address 会给你一个错误:)

编辑

请参阅此示例。在这里你甚至不需要激活工作表

Sub HypLinks()
    Dim wsA As Worksheet, wsB As Worksheet
    Dim NametoFind As String
    Dim lRow As Long
    Dim gg As Range, aCell As Range
    Dim rngA As Range, rngB As Range

    '~~> Set your worksheets
    Set wsA = Sheets("Sheet1")
    Set wsB = Sheets("Sheet2")

    '~~> Sheet2
    With wsB
        '~~> Find last row in Col B
        lRow = .Range("B" & .Rows.Count).End(xlUp).row
        '~~> Set you range
        Set rngB = .Range("B1:B" & lRow)
    End With

    '~~> Sheet1
    With wsA
        '~~> Find last row in Col C
        lRow = .Range("C" & .Rows.Count).End(xlUp).row
        '~~> Set you range
        Set rngA = .Range("C1:C" & lRow)

        '~~> looping through the range
        For Each aCell In rngA
            NametoFind = aCell.Value

            Set gg = rngB.Find(NametoFind, LookIn:=xlValues)

            '~~> If find returns a match
            If Not gg Is Nothing Then
                wsB.Hyperlinks.Add wsA.Range("Sheet1!C" & aCell.row), _
                Address:="", SubAddress:="#Sheet2!" & gg.Address, _
                TextToDisplay:=aCell.Value
            End If
        Next aCell
    End With
End Sub

【讨论】：