2017-01-16 2 views
0

У меня есть список ссылок с более чем 100000 ячеек.Как преодолеть лимит гиперссылок в Excel?

Example

Я должен дать гиперссылки на все из них. но в Excel у нас есть лимит 66530 гиперссылок на рабочий лист.

Как я могу преодолеть предел? или как я могу объединить ячейки с равными значениями с помощью макросов или VBS?

Sub AddHyperlinks() 

    Dim myRange As Range 
    Set myRange = Range("A1") 
    Dim hText As Variant 

    Do Until IsEmpty(myRange) 

    hText = Application.VLookup(myRange.Value, Worksheets("Sheet2").Range("A:B"), 2, False) 

    If IsError(hText) Then 
     hText = "" 
    Else 
     ActiveSheet.Hyperlinks.Add Anchor:=myRange, Address:="http://" + hText, TextToDisplay:=myRange.Text 
     hText = "" 
    End If 

    Set myRange = myRange.Offset(1, 0) 
Loop 

End Sub 
+0

Если вы не Не нужно открывать сразу несколько файлов, используйте кнопку с динамическим расположением (через рабочий лист se lection change), чтобы открыть файл (сохранить фактический путь в другом столбце). – PatricK

+0

вы можете использовать одну гиперссылку для диапазона смежных ячеек – Slai

+0

@Slai Можете ли вы помочь мне сделать это с помощью макросов? – ZeroEight

ответ

0

Только регулярная копия паста должна работать, но я могу обновить пример (не проверено), если он не

Sub AddHyperlinks() 

    Dim rng As Range, rngFrom As Range, values, r 
    Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1") 
    Set rngFrom = ThisWorkbook.Worksheets("Sheet2").Range("A:A") 

    rng.Worksheet.Hyperlinks.Delete ' remove all previous Hyperlinks 

    While rng(1) > "" 

     ' resize the range to the same values 
     While rng(rng.Rows.Count + 1) = rng(1) 
      Set rng = rng.Resize(rng.Rows.Count + 1) 
     Wend 

     r = Application.Match(rng(1), rngFrom, 0)  
     If Not IsError(r) Then 
      values = rng.Value2 ' save the values 
      rngFrom(r, 2).Copy rng ' copy from the cell next to the match 
      rng.Value2 = values ' restore the values (not sure if it removes the links) 
     End If 

     Set rng = rng(rng.Rows.Count + 1) ' move to the next cell below 
    Wend 

End Sub 
+0

Большое вам спасибо ... все работает, как и ожидалось. Могу ли я спросить вас, появится ли какая-нибудь проблема? – ZeroEight

+0

Я немного удивлен, что он работает без проблем, потому что я в основном догадывался, и я не мог его протестировать. Если это проблема, связанная с моим ответом или этим вопросом, конечно. – Slai

+0

У меня есть проблема, если у меня есть свободные ячейки в столбце, скрипт прерывается. Как я могу это исправить? – ZeroEight

0

Предел символов 255 применяется к пределу символа, который может быть помещен в формулу одной ячейки. Общим подходом к этому является разделение ссылки на несколько ячеек и использование формулы для их объединения.

=HYPERLINK(A1&A2,"Click Here") 
+0

Не лимит символов. Существует ограничение на количество гиперссылок на рабочий лист https://support.office.com/en-us/article/Excel-specifications-and-limits-1672b34d-7043-467e-8e27-269d656771c3 – ZeroEight

+0

AFAIK, этот предел 65536 не применяется при использовании формулы HYPERLINK. – Rory

1

Если вы храните URL в (например) COLA тогда что-то, как это должно работать:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) 
    Dim URL 
    If Target.Column <> 1 Then Exit Sub '<< only reacting if cell in URL column is right-clicked 
    URL = Target.Value 
    ThisWorkbook.FollowHyperlink URL 
End Sub 

В качестве альтернативы использовать Before_DoubleClick событие

Это означает, что вы не можете использовать " дружественный "текст ссылки, такой как« нажмите здесь », но вам, скорее всего, удастся это сделать, если вы сохраните текст URL с фиксированным смещением, а затем прочитайте, что вместо Target.Value

0

Я страдал от тех же проблем, и я знаю, что не должен быть больше, чем около 120000 строк, нужно гиперссылок так модифицирован некоторый код, который я нашел в другом потоке к этому

Sub hyperlink2() 
Dim Cell As Range 
Dim Cell2 As Range 
Dim rng As Range 
Dim Rng2 As Range 

Set rng = Range("X2:X60000") 


For Each Cell In rng 
    If Cell <> "" Then ActiveSheet.Hyperlinks.Add Cell, Cell.Value 
Next 

Set Rng2 = Range("X60001:X120000") 
For Each Cell2 In Rng2 
    If Cell2 <> "" Then ActiveSheet.Hyperlinks.Add Cell2, Cell2.Value 
Next 

End Sub 

Надежда, что помогает кто-то, кто натыкается на это через Google (как я сделал) в поисках приемлемого решения ...

Смежные вопросы