首页 文章

命名范围复制/公式更改

提问于
浏览
0

我目前正在使用命名范围的选项卡中工作 . 它们都与类1相关联 . 我想复制这些单元格两次,为类2和3创建相同的列 . 除了为后两个类附加的_2 / _3之外,命名范围应保持相同 . 我还需要在每列中更改公式,但包含正确的后缀(_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

这些代表了细胞的名称;它们都包含在每个类中链接的公式 . 已完成的1类区域有9列120行 . 我希望第二类填充第10列到第18列,将第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有关吗?任何帮助将非常感激!

子名称()将此字符串调暗为字符串Dim OldName As String Dim NewName2 As String Dim NewName3 As String Dim x As Integer 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

结束子

1 回答

  • 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
    

相关问题