时间戳

首页 > 解决方案 > Excel Header 和 Footer 文本替换太慢了，有替代方案吗？

excel - Excel Header 和 Footer 文本替换太慢了，有替代方案吗？

问题描述

我正在尝试用VBA替换excel左页眉（以及每个页眉和页脚）中的一组特定单词问题是它太慢了，2张纸大约需要40秒..

我已经用替换命令完成了它：

With osheet.PageSetup
    For i = 1 To footerfindreplace.count
          .LeftHeader = Application.WorksheetFunction.Substitute(.LeftHeader, footerfindreplace(i).TextReplace, footerfindreplace(i).TextReplaceBy)
    next i
End with

还有这种替代方法，但是将所有文本替换为我想要的单词，并且不保留我不想替换的剩余文本。

If .LeftHeader = footerfindreplace(i).TextReplace Then
     .LeftHeader = footerfindreplace(i).TextReplaceBy
End If

更新，

根据建议还尝试了 VBA.replace 它需要完全相同的时间.. 20 秒打开替换文本的文件，无论执行什么命令。我也试过把循环放在不同的地方，仍然没有改进。20秒内更换所有页眉和页脚需要20秒正常吗？

我查看了大约 15 个文本查找和替换的可能性，但是对于相同数量的可能性，cells.replace 命令可以完美地工作而不会延迟。

谢谢你的帮助

标签： excelvba

解决方案

您是否尝试过使用 VBA.Replace？
此代码将 LeftHeader 中的所有“Foo”替换为“Bar”。

替换Set pgSetup = Sheet1.PageSetup为您需要的任何内容，并在必要时循环。

Sub testRep()
    Dim pgSetup As PageSetup
    Dim findStr As String
    Dim repStr As String

    Set pgSetup = Sheet1.PageSetup
    findStr = "Foo"
    repStr = "Bar"

    pgSetup.LeftHeader = VBA.Replace(pgSetup.LeftHeader, findStr, repStr)

End Sub

编辑：
添加了一些额外的代码，你应该看到更新需要多长时间。作为比较，使用下面的代码 (testRep2)，使用 3 个标题 (R,C,L) 更新 5 张工作表，每张工作表需要 0.1 到 1 秒（比没有Application.ScreenUpdatingand快大约 3 倍Application.DisplayStatusBar）。

Sub testRep2()
    Dim sht As Worksheet
    Dim findStr As String
    Dim repStr As String
    Dim start As Long
    Dim startSheet As Long

    findStr = "Foo"
    repStr = "Bar"

    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False

    start = timer
    For Each sht In ActiveWorkbook.Worksheets
        startSheet = timer
        With sht.PageSetup
            .LeftHeader = VBA.Replace(.LeftHeader, findStr, repStr)
            .CenterHeader = VBA.Replace(.CenterHeader, findStr, repStr)
            .RightHeader = VBA.Replace(.RightHeader, findStr, repStr)
        End With
        Debug.Print sht.Name, timer - startSheet
    Next sht
    Debug.Print "Total:", timer - start

    Application.DisplayStatusBar = True
    Application.ScreenUpdating = True

End Sub


Sheet1 (5)     0.796875 
Sheet1 (4)     0.34765625 
Sheet1 (3)     0.89453125 
Sheet1 (2)     0.42578125 
Sheet1         0.96875 
Total:         2.96875

推荐阅读