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

Question

我正在制作一张有两张纸的Excel工作簿。在第一张纸的第C列（Sheet1！C1：C500）中，每个单元格中都有一个字符串。我编写了以下代码，以找到该字符串在工作表2（Sheet2！B1：B184）的B列中的位置，并将工作表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页。

Answer 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