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

Lee*_*edo 2 arrays excel vba hyperlink

我使用下面的代码来修改TextToDisplay一万个单元格列的超链接。
\n它可以工作,但代码需要大约 10 秒才能完成(在高端 PC 上)。
\n我正在寻找一种更快的方法来完成这项任务。
\n我尝试将所有超链接放在一个数组上,但代码出现以下错误

\n
 Dim rng As Range\n  Set rng = ws.Range("N2", ws.Cells(Rows.Count, "N").End(xlUp))\n       Dim arr\n         arr = rng.Hyperlinks \xe2\x80\x98Run-time error 450: Wrong number of arguments or invalid property assignment\n
Run Code Online (Sandbox Code Playgroud)\n

这是工作代码,但速度很慢。
\n我也尝试过关闭screenupdating,但没有什么区别。
\n提前感谢任何有用的评论和答案。
\n在此输入图像描述

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

Tin*_*Man 5

我们可以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
Run Code Online (Sandbox Code Playgroud)