Question

B列是员工姓名，也是个人工作表名称。

预期结果：指向B列中每个项目的单个工作表的超链接。

问题：代码在列表顶部开始和停止，并放入指向列表中最后一名员工的超链接。

Sub HyperlinkAdd()
    ts= "Employee List"
    lx = sheets(ts).Range("L1").value
    Sheets(ts).Range("L1").Formula= "=Subtotal(3,B4:B1000)+3"

    For x = 3 to lx
        If Range("B" & x).value <> "" And Range("B" & x).value <> "Employees" Then

           Sheets(ts).Hyperlinks.Add Anchor:Selection, Address:="", _
             Subaddress:="'" & Range("B" & x) & "'!A1"

        Else

        End if

    Next X

End Sub

Answer 1

试试这个：

Sub add_hyperlink()

Dim target_range As Range
Dim cell As Range

Set target_range = ThisWorkbook.Sheets("Sheet1").Range("B1", Range("B1").End(xlDown))

For Each cell In target_range

ThisWorkbook.Sheets("Sheet1").Hyperlinks.Add Anchor:=cell, Address:="https://www.google.com/", SubAddress:= _
        "Sheet1!A1", TextToDisplay:=cell.Value

Next cell

End Sub

Answer 2

以下内容如何，只需修改您想要使用的范围，我已将其设置为从B1到B列上最后一个填充的单元格：

Sub HyperlinkAdd()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
'declare and set your working worksheet, amend as required
Dim LastRow As Long
Dim rng As Range, cell As Range

LastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
'get the last row with data on Column b
Set rng = ws.Range(ws.Range("B1"), ws.Range("B" & LastRow))
'set the range to work with

For Each cell In rng
  If cell.Value <> "" And cell.Value <> "Employees" Then
    ws.Hyperlinks.Add Anchor:=cell, Address:="", SubAddress:=cell.Value & "!A1", TextToDisplay:=cell.Value
  End If
Next
End Sub

Answer 3

我采取了不同的方针，制作了一个目录，其中每张纸（例外）都添加到了列表中，并且超链接向前和向后。您需要将员工表上“返回”链接的位置更改为合适的位置。

Private Sub Make_TOC()
'TOC Table of contents Hyperlink
Dim bkEmployees As Workbook
Set bkEmployees = ActiveWorkbook
Dim shContents As Worksheet, shDetail As Worksheet

If Not WorksheetExists("Contents") Then
    Set shContents = bkEmployees.Sheets.Add(before:=ActiveWorkbook.Sheets(1))
    shContents.Name = "Contents"
Else
    Set shContents = bkEmployees.Sheets("Contents")
    shContents.Move before:=bkEmployees.Sheets(1)
End If

shContents.Activate
shContents.Range("A1").Select
shContents.Columns("A:B").NumberFormat = "@"

For locX = 2 To bkEmployees.Sheets.Count
    Select Case bkEmployees.Sheets(locX).Name

    'add any sheets you don't want messed with
        Case "Sheet1", "Sheet2", "Contents"
            'don't include the sheets above in the TOC
        Case Else
            shContents.Cells(locX, 1) = bkEmployees.Sheets(locX).Name
            shContents.Cells(locX, 1).Select

            strSubAddress = "'" & shContents.Cells(locX, 1).Value & "'!A1"
            shContents.Hyperlinks.Add Anchor:=shContents.Cells(locX, 1), _
            Address:="", SubAddress:="'" & bkEmployees.Sheets(locX).Name & "'" & "!A1", _
            TextToDisplay:=bkEmployees.Sheets(locX).Name, ScreenTip:="Go to Detail Sheet"

            'change this code to put the anchor for the return link somewhere suitable.
            bkEmployees.Sheets(locX).Hyperlinks.Add Anchor:=bkEmployees.Sheets(locX).Cells(1, 1), _
            Address:="", SubAddress:="'" & shContents.Name & "'" & "!A" & locX, _
            TextToDisplay:="Return to TOC", ScreenTip:="Return to Table of Contents"
    End Select
Next locX
shContents.Range("A1").Value = "Table Of Contents"
shContents.Range("A1").Select
shContents.Columns("A").AutoFit
End Sub

如何为列中的每个项添加超链接？

3 个答案: