замена формул

[ratibor]

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range: Set rng = [C4:C6]
If Not Intersect(rng, Target) Is Nothing Then
    With Application
    .EnableEvents = False
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
[F:W].Replace "[*.xlsm]", "[" & [c7] & ".xlsm]"
    If [C6] = "План" Then
    [F:G].Replace "!G", "!F"
    [J:K].Replace "!K", "!J"
    [N:O].Replace "!O", "!N"
    [R:S].Replace "!S", "!R"
    [V:W].Replace "!W", "!V"
    ElseIf [C6] = "Факт" Then
    [F:G].Replace "!F", "!G"
    [J:K].Replace "!J", "!K"
    [N:O].Replace "!N", "!O"
    [R:S].Replace "!R", "!S"
    [V:W].Replace "!V", "!W"
    End If
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
    End With
End If
End Sub

Теперь замена идет, когда меняется значение в ячейках С4 или С6, но не могу понять как сделать, чтобы было раздельно. Если меняется С4, то выполняется:

[F:W].Replace "[*.xlsm]", "[" & [c7] & ".xlsm]"

, а если С6, то:

If [C6] = "План" Then
    [F:G].Replace "!G", "!F"
    [J:K].Replace "!K", "!J"
    [N:O].Replace "!O", "!N"
    [R:S].Replace "!S", "!R"
    [V:W].Replace "!W", "!V"
    ElseIf [C6] = "Факт" Then
    [F:G].Replace "!F", "!G"
    [J:K].Replace "!J", "!K"
    [N:O].Replace "!N", "!O"
    [R:S].Replace "!R", "!S"
    [V:W].Replace "!V", "!W"
    End If

[Hugo121]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range: Set rng = Range("C4, C6")
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(rng, Target) Is Nothing Then
        With Application
            .EnableEvents = False
            .ScreenUpdating = False
            .Calculation = xlCalculationManual
            If Target.Address(0, 0) = "C4" Then
                [F:W].Replace "[*.xlsm]", "[" & [c7] & ".xlsm]"
            Else
                If [C6] = "План" Then
                    [F:G].Replace "!G", "!F"
                    [J:K].Replace "!K", "!J"
                    [N:O].Replace "!O", "!N"
                    [R:S].Replace "!S", "!R"
                    [V:W].Replace "!W", "!V"
                ElseIf [C6] = "Факт" Then
                    [F:G].Replace "!F", "!G"
                    [J:K].Replace "!J", "!K"
                    [N:O].Replace "!N", "!O"
                    [R:S].Replace "!R", "!S"
                    [V:W].Replace "!V", "!W"
                End If
            End If
            .Calculation = xlCalculationAutomatic
            .ScreenUpdating = True
            .EnableEvents = True
        End With
    End If
End Sub

[ratibor]

Hugo121 Мегареспект, все работает и в два раза быстрей.

[Hugo121]

Только в 2?
За 12 минут?

[ratibor]

Сообщение от Hugo121

Только в 2?
За 12 минут?

К сожалению, да. На маленьких таблицах отлично работает. А вот на больших... Теперь думаю как это через копирование переделать. Затык в том, как сослаться на файлы, если папку с ними перенесли в другое место?

[RAN.]

А может ну его, Replace ?
Может просто новые вставлять?

Sub Макрос3()
t = Timer
    [A1:A10000].FormulaR1C1 = "=5"
Debug.Print Format(Timer - t, "0.000000") '== 0,027344==
End Sub

[ratibor]

Сообщение от RAN.

А может ну его, Replace ?
Может просто новые вставлять?

Sub Макрос3()
t = Timer
    [A1:A10000].FormulaR1C1 = "=5"
Debug.Print Format(Timer - t, "0.000000") '== 0,027344==
End Sub

RAN, а можно поподробнее, что код делает?

[RAN.]

Как что?
Вставляет в 10000 ячеек столбца А формулу "=5" (другую сочинять лень было)
Время работы - 0,27 сек.