大范围超链接修改 (TextToDisplay) 的更快方法

Question

我正在使用以下代码修改一列 10k 单元格的 TextToDisplay 超链接。
它有效，但代码需要大约 10 秒才能完成（在高端 PC 上）。
我正在寻找一种更快的方法来完成这项任务。
我试图将所有超链接放在一个数组中，但在代码

上出现以下错误

 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 ，但没有任何区别。
预先感谢任何有用的评论和答案。

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

Answer 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

大范围超链接修改 (TextToDisplay) 的更快方法

Faster method to modify (TextToDisplay) of hyperlinks on a big range

arrays

excel

vba

hyperlink