excel - 动态创建命名单元格

Question

我有一本包含 3 个工作表的工作簿。一个工作表将包含输入值(目前尚未创建，并且此问题不需要)，一个工作表包含多个"template"或“源”表，最后一个工作表包含 4 个格式化的“目标”表(空或不空)没关系)。每个模板表都有 3 列，其中一列标识后 2 列中的值的用途。值列中包含公式，并且每个单元格均已命名。这些公式使用单元格名称而不是单元格地址(例如，MyData1 而不是 C2)。

我试图将模板复制到目标表中，同时还将单元格名称从源复制到目标中，或者根据源单元格名称在目标表中创建名称。我在下面的代码中使用名称中的“基”来创建目标名称，该名称将根据其复制到的目标表而更改。我的示例表的所有单元格名称均以“Num0_”为基础(例如 Num0_MyData1、Num0_SomeOtherData2 等)。复制完成后，代码将通过查看目标名称(和地址)来命名单元格，用新的基数替换名称的基数，只需添加它要转到的目标表的数字，然后替换工作表地址中的姓名。

这就是我需要帮助的地方。仅当我的模板和目标使用其透视表的相同单元格地址时，我更改该地址的方式才有效。但他们不是。 (例如，Template1 表具有值单元格，每个单元格都命名为 B2 到 C10，我的副本目标表可能是 F52 到 G60)。最重要的是，我需要弄清楚如何使用模板复制这些名称，或者通过执行诸如替换之类的操作来动态命名单元格，其中我根据目标表递增地址值#...记住我有 4 个目标表，其中是静态的，我只会复制到这些区域。我是 VBA 新手，因此感谢任何建议或帮助。

注意:表的复制按我想要的方式工作。它甚至命名单元格(如果模板和目标表具有相同的本地工作表单元格地址(例如 C2)

'Declare Module level variables
'Variables for target tables are defined in sub's for each target table.
Dim cellName As Name
Dim newName As String
Dim newAddress As String
Dim newSheetVar
Dim oldSheetVar
Dim oldNameVar
Dim srcTable1

Sub copyTables()

newSheetVar = "TestSheet"
oldSheetVar = "Templates"
oldNameVar = "Num0_"
srcTable1 = "TestTableTemplate"

'Call sub functions to copy tables, name cells and update functions.
copySrc1Table
copySrc2Table
End Sub

'****there is another sub identical to this one below for copySrc2Table. 
Sub copySrc1Table()

newNameVar = "Num1_"
trgTable1 = "SourceEnvTable1"
    Sheets(oldSheetVar).Select
    Range(srcTable1).Select
    Selection.Copy
    For Each cellName In ActiveWorkbook.Names
    'Find all names with common value
        If cellName.Name Like oldNameVar & "*" Then
      'Replace the common value with the update value you need
        newName = Replace(cellName.Name, oldNameVar, newNameVar)
        newAddress = Replace(cellName.RefersTo, oldSheetVar, newSheetVar)
      'Edit the name of the name. This will change any formulas using this name as well
        ActiveWorkbook.Names.Add Name:=newName, RefersTo:=newAddress
        End If
    Next cellName
    Sheets(newSheetVar).Select
    Range(trgTable1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

End Sub

Answer 1

我已经更新了 copySrc1Table() 过程，删除了设置 newAdress 行上的 find 方法。我已将其替换为首先设置为源 cellname.refers 值的字符串。该值被发送到一个新的子(子 UpdateRefersTo)，该子将其值更改为所需的值，然后用于设置 newAdress 值

'****there is another sub identical to this one below for copySrc2Table.
Sub copySrc1Table()
Dim trgTable1
Dim vSplitAdress As Variant
Dim sRefersTo As String

newNameVar = "Num1_"
trgTable1 = "SourceEnvTable1"
    Sheets(oldSheetVar).Select
    Range(srcTable1).Select
    Selection.Copy
    Sheets(newSheetVar).Select
    Range(trgTable1).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False

    For Each cellName In ActiveWorkbook.Names
    'Find all names with common value
        If cellName.Name Like oldNameVar & "*" Then
      'Replace the common value with the update value you need
        sRefersTo = cellName.RefersTo
        Call UpdateRefersTo(sRefersTo)
        newName = Replace(cellName.Name, oldNameVar, newNameVar)
        newAddress = sRefersTo
      'Edit the name of the name. This will change any formulas using this name as well
        ActiveWorkbook.Names.Add Name:=newName, RefersTo:=newAddress
        End If
    Next cellName

它使用 case 元素来完成此操作，因此对于模板工作表中的每个地址，您需要为名为 range 的测试表应引用的内容编写一个 case 语句。这不是一个优雅的解决方案，但它应该有效。当然，您仍然需要更改新表中的函数，但这应该不会太难。

End Sub

Sub UpdateRefersTo(ByRef sRefersTo As String)
Dim sString As String

Select Case sRefersTo
    Case "=Templates!$B$2"
        sRefersTo = "=TestSheet!$F$52"
    Case "=Templates!$B$3"
        sRefersTo = "=TestSheet!$F$53"
    Case "=Templates!$B$4"
        sRefersTo = "=TestSheet!$F$54"
    Case "=Templates!$B$5"
        sRefersTo = "=TestSheet!$F$55"
    Case "=Templates!$B$6"
        sRefersTo = "=TestSheet!$F$56"
    Case "=Templates!$B$7"
        sRefersTo = "=TestSheet!$F$57"
    Case "=Templates!$B$8"
        sRefersTo = "=TestSheet!$F$58"
    Case "=Templates!$B$9"
        sRefersTo = "=TestSheet!$F$59"
    Case "=Templates!$B$10"
        sRefersTo = "=TestSheet!$F$60"
    Case "=Templates!$C$2"
        sRefersTo = "=TestSheet!$G$52"
    Case "=Templates!$C$3"
        sRefersTo = "=TestSheet!$G$53"
    Case "=Templates!$C$4"
        sRefersTo = "=TestSheet!$G$54"
    Case "=Templates!$C$5"
        sRefersTo = "=TestSheet!$G$55"
    Case "=Templates!$C$6"
        sRefersTo = "=TestSheet!$G$56"
    Case "=Templates!$C$7"
        sRefersTo = "=TestSheet!$G$57"
    Case "=Templates!$C$8"
        sRefersTo = "=TestSheet!$G$58"
    Case "=Templates!$C$9"
        sRefersTo = "=TestSheet!$G$59"
    Case "=Templates!$C$10"
        sRefersTo = "=TestSheet!$G$60"

End Select

End Sub