需要使用VBA更改复制的Excel公式的名称

Question

我的工作簿中有名为Wk1，Wk2 Wk3等的工作表。

所有Wk1表中的公式都以Wk1为前缀，例如= Wk1MonWeight

将公式从Wk1表复制到任何其他表后，我使用下面的代码将前缀Wk1更改为复制到的表单名称，例如在复制= Wk1MonWeight到Wk2表后，公式变为= Wk2MonWeight 。这段代码有效。

Sub Step2ChangeWkNamesInFormulasOnNewWksheet()

    Dim ws As Worksheet
    Dim r As Range

    For Each ws In Worksheets
        If InStr(1, ws.Name, "Wk", 1) > 0 Then
            For Each r In ws.Range("C116:I119")
                r.Formula = Replace(r.Formula, "Wk1", r.Parent.Name)
            Next r

            For Each r In ws.Range("C184:J188")
                r.Formula = Replace(r.Formula, "Wk1", r.Parent.Name)
            Next r

            For Each r In ws.Range("E341:AY341")
                r.Formula = Replace(r.Formula, "Wk1", r.Parent.Name)
            Next r


        End If
    Next ws

    MsgBox "Done"
    End Sub

我想更改下面的代码片段，以便前缀从Wk1更改为工作表复制到+ Avg 之前的工作表名称。  例如，当公式 = Wk1MonWeight 从Wk1表复制到 Wk4 表时，它变为 = Wk3AvgWeight

For Each r In ws.Range("E341:AY341")
                r.Formula = Replace(r.Formula, "Wk1", r.Parent.Name)
            Next r

任何人都可以帮忙解决这个问题。

谢谢

Answer 1

根据你的描述，这应该这样做：

修改

Sub Step2ChangeWkNamesInFormulasOnNewWksheet()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    On Error GoTo ErrHandler

    Dim ws As Worksheet, r As Range
    For Each ws In Worksheets
        If InStr(1, ws.Name, "Wk", 1) = 1 And InStr(1, ws.Name, "Wk1", 1) = 0 Then
            For Each r In ws.Range("C116:I119, C184:J188")
                r.Formula = Replace(r.Formula, "Wk1", r.Parent.Name)
            Next r
            For Each r In ws.Range("E341:AY341")
                r.Formula = Replace(r.Formula, "Wk1Mon", Sheets(r.Parent.Index - 1).Name & "Avg")
            Next r
         End If
    Next

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    MsgBox "Done"  
    Exit Sub

ErrHandler:
    MsgBox "Something Went wrong: " & vbCrLf & Err.Description
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub