命名范围复制/公式更改

Question

我目前正在一个具有命名范围的选项卡中工作。它们都与 class 1 相关联。我想将这些单元格复制两次，为 classes 2 和 3 创建相同的列。命名范围应保持不变，除了附加的 _2/_3接下来的两个 classes。我还需要在每一列中更改公式，但包含正确的后缀 (_2/_3)。

这是一个简化版本，可以更好地解释我正在尝试做的事情：

**Class 1** 

  Lives         
  Age       
  Adjust        
  Claim     
  Risk      

**Class1    Class2      Class3**

  Lives     Lives_2     Lives_3

  Age       Age_2       Age_3

  Adjust    Adjust_2    Adjust_3

  Claim     Claim_2     Claim_3

  Risk      Risk_2      Risk_3

这些代表了细胞的名称；它们还都包含在每个 class 中链接的公式。已经完成的class1区有9列120行。我想 class 两个填充第 10 到 18 列，class 3 填充下一个 9。这是我正在使用的代码，试图只更改名称但我没有成功：

Sub ChangeNames()
    Dim OldName As String
    Dim NewName2 As String
    Dim NewName3 As String
    Dim rng As Range



    For r = 1 To 127
        For c = 1 To 10
            If IsNamedRange(Cells(r, 1 + c)) Then
                    Set rng = Sheets("Medical").Cells(r, 1 + c)

                    OldName = rng.Name
                    NewName2 = OldName & "_2"
                    NewName3 = OldName & "_3"

                    Sheets("Medical").Cells(r, 11 + c).Name = NewName2
                    Sheets("Medical").Cells(r, 21 + c).Name = NewName3

            End If

        Next c
    Next r


End Sub

Function IsNamedRange(MyRange) As Boolean
    Dim vntName As Variant
    On Error Resume Next
        IsNamedRange = MyRange.Name <> ""
    Exit Function
End Function

VBA 可以吗？任何帮助将不胜感激！

子名称() 将此调暗为字符串将旧名称变暗为字符串将 NewName2 调暗为字符串将 NewName3 调暗为字符串 Dim x 为整数 Dim y As Integer

For Each this In Workbook.names
    If Range(this).Worksheet = "Medical" Then
        NewName2 = Range(this).Name & "_2"
        NewName3 = Range(this).Name & "_3"
        x = Range(this).Column
        y = Range(this).Row
        Sheets("Medical").Cells(x, 10 + y).Name = NewName2
        Sheets("Medical").Cells(x, 20 + y).Name = NewName3
    End If

Next this

结束子

Answer 1

试试这个代码，您可能需要对偏移量进行小幅调整或调整以适合您的确切数据集，但我已尽可能精确地定义它。

Sub ChangeNames()

    Dim rName As Name
    For Each rName In ThisWorkbook.Names

        If rName.RefersToRange.Parent.Name = "Medical" Then

            Select Case rName.RefersToRange.Column

                Case 2 To 10

                    For i = 1 To 2

                        Dim sName As String
                        sName = "=" & rName.RefersToRange.Offset(, i * 10).Parent.Name
                        sName = sName & "!" & rName.RefersToRange.Offset(, i * 10).Address
                        ThisWorkbook.Names.Add rName.Name.Name & "_" & i + 1, RefersTo:=sName

                    Next

            End Select

        End If

    Next

End Sub

命名范围复制/公式更改

Named Range Duplication/ Formula Altering

excel

vba

named