Замена текста в верхнем и нижнем колонтитуле Excel выполняется слишком медленно, есть ли альтернативы?

Question

Я пытаюсь заменить определенный набор слов в левом верхнем колонтитуле Excel (и, соответственно, на каждый верхний и нижний колонтитулы) на VBA. Проблема в том, что это слишком медленно, на 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 возможностей поиска и замены текста, но для того же количества возможностей команда cell.replace работает без задержек.

Спасибо за любую помощь

Answer 1

Вы пробовали использовать VBA.Replace?
Этот код заменяет все «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

Edit:
Добавлен дополнительный код, с этим вы должны увидеть, сколько времени занимает обновление. Для сравнения, с приведенным ниже кодом (testRep2), обновление 5 листов с 3 заголовками (R, C, L) каждый занимает от 0,1 до 1 секунды на лист (примерно в 3 раза быстрее, чем без Application.ScreenUpdating и 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