Создать гиперссылку в столбце на листе Excel, чтобы открыть многослойную подпапку

У меня есть такие папки и подпапки, как эти 8 слоев и 500 КБ записей на одном листе:

C:\999\236\857\871 
C:\999\234\567\874 
C:\999\234\567\873 
C:\999\234\586\396 
C:\999\234\566\458

Столбец A на тестовом листе содержит данные

236857871 
234567874 
234567873 
234586396 
234566458

Я хотел создать макрос для создания гиперссылки на существующие данные в столбце A, чтобы при нажатии на данные открывалась соответствующая папка. Я привил макрос из того, что был доступен в StackOverflow ниже. Он создает только одно место назначения ... он не может создать ссылку для соответствующих записей. Могу я получить помощь?

Sub HyperlinkNums ()
Dim WK As Workbooks
Dim sh As Worksheet
Dim i As Long
Dim lr As Long
Dim Rng As Range, Cell As Range
Set sh = Workbooks("Bigboss.xlsm").Sheets("Test")
lr = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
Set Rng = sh.Range("A5:A" & lr)

sh.range("A5").Activate

For i = 7 To lr
For Each Cell In Rng

If Cell.Value > 1 Then

   sh.Hyperlinks.Add Anchor:=Cell, Address:= _
        "C:\999\" & Left(ActiveCell, 3) & "\" & _
        Mid(ActiveCell, 4, 3) & "\" & Mid(ActiveCell, 7, 3) & "\" & _
        Right(ActiveCell, 3), TextToDisplay:=Cell.Value

End If


Next Cell
Next

End Sub.
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
1
0
11
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Итак, самая большая проблема в вашем коде заключается в том, что вы всегда имеете в виду ActiveCell. Вы используете цикл For Each...Next, и вы должны использовать объект rng, который вы зацикливаете.

У вас также есть резервный шлейф: For i = 7 To lr. От этого можно избавиться.

И я не большой поклонник использования полузарезервированных ключевых слов в качестве переменных, поэтому я немного переименовал переменную cell в cel. Я думаю, это может быть то, что вы ищете:

Option Explicit

Sub HyperlinkNums()
    Dim WK As Workbooks
    Dim sh As Worksheet
    Dim lr As Long
    Dim Rng As Range, Cel As Range
    Set sh = Workbooks("Bigboss.xlsm").Sheets("Test")
    lr = sh.Range("A" & sh.Rows.Count).End(xlUp).Row
    Set Rng = sh.Range("A5:A" & lr)

    sh.Range("A5").Activate

    For Each Cel In Rng

        If Cel.Value > 1 Then

            sh.Hyperlinks.Add Cel, "C:\999\" & Left(Cel.Text, 3) & "\" & _
                    Mid(Cel.Text, 4, 3) & "\" & Right(Cel.Text, 3), _
                    TextToDisplay:=Cel.Text

        End If


    Next Cel

End Sub

Кроме того, меня немного смутило использование Mid(ActiveCell, 7, 3), которое, похоже, имело то же значение, что и Right(ActiveCell, 3). Я удалил эту часть.

Большое спасибо, К. Дэвис. Ваше решение замечательное. Я удалил sh.Range ("A5"). Активируйте то, что я добавил в отчаянии. Мне удалось получить то, что я хотел сделать. Тонны благодарности.

kailash 24.08.2018 02:28

Другие вопросы по теме