更快地修改超链接的超链接的方法

发布于 2025-01-27 06:22:39 字数 1625 浏览 0 评论 0原文

我正在使用以下代码修改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

这是工作代码,但它很慢。
我还尝试关闭筛选,但没有区别。
事先,感谢任何有用的评论和答案。

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

I am using the below code to modify TextToDisplay of hyperlinks for a column of 10k cells.
It works, but the code takes about 10 seconds to finish (on high end PC).
I am seeking for a faster method to fulfil this task.
I tried to put all the hyperlinks on an array ,but I got the below error on code

 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

This the working code, but it is slow.
I also tried turn off screenupdating , but it make no difference.
In advance, grateful for any helpful comments and answers.
enter image description here

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

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。

评论(1

许你一世情深 2025-02-03 06:22:39

我们可以像其他任何值一样替换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

We can replace the Range.TextToDisplay value using an array just like any other value. I haven't tested this on a large range but it should be significantly faster than iterating over the cells.

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
~没有更多了~
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文