首页 文章

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

提问于
浏览 次
1

我正在制作一张有两张纸的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 .

excel-vba hyperlink vba excel

1 回答

  • 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 会给你一个错误:)

    Edit

    看这个例子 . 在这里，您甚至不需要激活工作表

    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
    回复于

相关问题