Более быстрый метод изменения (TextToDisplay) гиперссылок в большом диапазоне

Я использую приведенный ниже код для изменения TextToDisplay гиперссылок для столбца из 10 тыс. ячеек.
Это работает, но выполнение кода занимает около 10 секунд (на высокопроизводительном ПК).
Я ищу более быстрый способ выполнить эту задачу.
Я попытался поместить все гиперссылки в массив, но получил следующую ошибку в коде

 Dim rng As Range
  Set rng = ws.Range("N2", ws.Cells(Rows.Count, "N").End(xlUp))
       Dim arr
         arr = rng.Hyperlinks ‘Run-time error 450: Wrong number of arguments or invalid property assignment

Это рабочий код, но он медленный.
Я также пробовал отключить screenupdating , но это не имеет значения.
Заранее благодарен за любые полезные комментарии и ответы.
Более быстрый метод изменения (TextToDisplay) гиперссылок в большом диапазоне

Option Explicit
Option Compare Text
Sub Replace_Hyperlinks_TextToDisplay_Q()
 
    Dim ws As Worksheet: Set ws = ActiveSheet
     Dim LastRow As Long
      LastRow = ws.Range("O" & Rows.Count).End(xlUp).Row
 
    Const str1 As String = "http://xxxxx/"
    Const str2 As String = "\"
 
    Dim i As Long
     For i = 2 To LastRow
       If ws.Range("O" & i).Hyperlinks.Count > 0 Then
          ws.Range("O" & i).Hyperlinks(1).TextToDisplay = Replace(Range("O" & i), str1, "")
          ws.Range("O" & i).Hyperlinks(1).TextToDisplay = Replace(Range("O" & i), str2, " - " & vbLf)
          ws.Range("O" & i).Hyperlinks(1).TextToDisplay = UCase(Left(ws.Range("O" & i).Hyperlinks(1).TextToDisplay, 1)) _
                                                         + Mid(ws.Range("O" & i).Hyperlinks(1).TextToDisplay, 2, _
                                                           Len(ws.Range("O" & i).Hyperlinks(1).TextToDisplay))
        End If
      Next i
End Sub

Application.ScreenUpdating = False и Application.EnableEvents = False могут немного помочь. Не забудьте установить их обратно на True в конце сабвуфера.

— 09.05.2022 16:39

@cybernetic.nomad, я пытался, но разница составляет доли секунды

— 09.05.2022 16:49

Вот почему я сказал мая, и, как сказал @BigBen, это, вероятно, так быстро, как вы можете получить

— 09.05.2022 16:54

arrays excel vba hyperlink

09.05.2022 16:32

Структурированный массив Numpy

Однако в реальных проектах я чаще всего имею дело со списками, состоящими из нескольких типов данных. Как мы можем использовать массивы numpy, чтобы...

3 эффективных способа найти максимальное значение в массивах JavaScript

T - 1Bits: Генерация последовательного массива

По мере того, как мы пишем все больше кода, мы привыкаем к определенным способам действий. То тут, то там мы находим код, который заставляет нас...

Что такое деструктуризация массива в JavaScript?

Деструктуризация позволяет распаковывать значения из массивов и добавлять их в отдельные переменные.

Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

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

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

Sub Replace_Hyperlinks_TextToDisplay_Q2()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Const str1 As String = "http://xxxxx/"
    Const str2 As String = "\"
    
    Dim Target As Range
    Dim Data As Variant
    
    With ActiveSheet
        Set Target = .Range("O1", .Cells(.Rows.Count, "O").End(xlUp))
    End With
    
    Data = Target.Value
    
    Dim r As Long
    
    For r = 1 To UBound(Data)
          Data(r, 1) = Replace(Data(r, 1), str1, "")
          Data(r, 1) = Replace(Data(r, 1), str2, " - " & vbLf)
          Data(r, 1) = UCase(Left(Data(r, 1), 1)) & Mid(Data(r, 1), 2, Len(Data(r, 1)))
    Next
    
    Target.Value = Data
    Application.Calculation = xlCalculationAutomatic
End Sub

Это работает как скорость ракеты, ваш код завершается за 0,4 секунды ??

— 09.05.2022 17:24

09.05.2022 17:13