У меня есть такие папки и подпапки, как эти 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.
Итак, самая большая проблема в вашем коде заключается в том, что вы всегда имеете в виду 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"). Активируйте то, что я добавил в отчаянии. Мне удалось получить то, что я хотел сделать. Тонны благодарности.