命名范围重复/公式改变

我目前正在使用命名范围的选项卡内工作。 他们都与类1相关联。我想复制这些单元格两次，为类别2和3创build相同的列。命名的范围应保持相同，除了_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行。 我希望第二节填写第十列到第十八列，第三class填写第九列。下面是我正在努力改变名称的代码，但是我没有成功：

 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？ 任何帮助将非常感激！

Sub names（）Dim this As String 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 

结束小组

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