Создание гиперссылки на ячейки со значениями для столбца Specifi c

Question

Цель: связать все ячейки в указанном c диапазоне (скажем, в диапазоне B7: B47) из указанного столбца c через гиперссылку, которая отправляет его в ячейку с другого листа.

на диапазон / Ячейка адреса гиперссылки изменяется на 50 строк.

Запросить помощь, как это исправить - извинения за плохое кодирование:

Range("B7").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A3"
Range("B8").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A53"
Range("B9").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A103"
Range("B10").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A153"
Range("B11").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A203"
Range("B12").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A253"
Range("B13").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A303"
Range("B14").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A353"
Range("B15").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A403"
Range("B16").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A453"
Range("B17").Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'Screenshots1'!A503"

Answer 1

Процесс:

1. Определить переменные
2. Инициализировать их
3. L oop через ячейки в диапазоне
4. Проверить, если ячейка не пусто
5. Добавьте гиперссылки соответственно

Прочитайте комментарии и настройте их в соответствии с вашими потребностями.

Код:

Option Explicit

Public Sub AddHyperlinks()

    Dim evalSheet As Worksheet
    Dim targetSheet As Worksheet
    Dim evalRange As Range
    Dim evalCell As Range

    Dim targetStartRow As Long
    Dim targetRowInterval As Long
    Dim targetRow As Long

    ' Customize this part
    Set evalSheet = ThisWorkbook.Worksheets("Sheet1")
    Set targetSheet = ThisWorkbook.Worksheets("Screenshots1")

    Set evalRange = evalSheet.Range("B7:B47")

    targetStartRow = 3
    targetRowInterval = 50

    ' Set initial row
    targetRow = targetStartRow

    ' Loop through each cell in evaluated range
    For Each evalCell In evalRange.Cells

        ' Execute only if cell is not empty
        If evalCell.Value <> vbNullString Then

            ' Add the hyperlink to the evaluated cell
            evalSheet.Hyperlinks.Add Anchor:=evalCell, Address:="", SubAddress:=targetSheet.Name & "!A" & targetRow, TextToDisplay:="Link"

            ' Increment the hyperlink target row
            targetRow = targetRow + targetRowInterval

        End If

    Next evalCell

End Sub

Дайте мне знать, если это работает