Excel VBA从工作表中的公式创建命名范围

您好，我的一些VBA代码有问题

我正在制作一个多动态表，帮助我保持对程序的控制。 因此，当我调整表中的某些内容时，我可以使用此代码来更新我的所有代码

在表中，我使用这段代码来定位所需的数据，到目前为止，它工作得很好

Source_1_Criteria = "Factuur"
Source_1 = Range("MDM_MDM_Tool_List").Find(what:=Source_1_Criteria).Offset(0, 1).Value

Me.ListBox1.RowSource = Source_1

现在我想用同样的代码加上一点额外的代码来创建一个命名范围。 当我使用一个只有一些文本的单元格时，这是有效的，但是当我用公式填充单元格时，VBA会抛出一个错误

Source_1_Criteria = "Factuur"
Source_1_Name = Range("MDM_MDM_Tool_List").Find(what:=Source_1_Criteria).Offset(0, 2).Value
Source_1_Area = Range("MDM_MDM_Tool_List").Find(what:=Source_1_Criteria).Offset(0, 4).Value

ActiveWorkbook.Names.Add Name:=Source_1_Name, RefersTo:=Source_1_Area

范围源_1_区域的内容为

=VERSCHUIVING(archief!$A$2;0;0;1;AANTALARG(archief!$A$3:$Y$3))

当我place=archief时，我使用的代码确实有效$里面有2美元

---

为什么我的大公式不起作用？

这将使用您在指定范围内给出的公式

Sub Test()

    AllocateNamedRange ThisWorkbook, "SomeName", "=VERSCHUIVING(archief!$A$2;0;0;1;AANTALARG(archief!$A$3:$Y$3))", "A1"

    'English version:
    'AllocateNamedRange ThisWorkbook, "SomeName", "=OFFSET(archief!$A$2,0,0,1,COUNTA(archief!$A$3:$Y$3))", "A1"

End Sub

Sub Test2()

    'Using some of your code to find the name.
    Dim rFoundRange As Range

    With ThisWorkbook.Worksheets("Sheet1").Range("MDM_MDM_Tool_List")
        Set rFoundRange = .Find(what:=Source_1_Criteria)

        'If Source_1_Criteria isn't found it will throw an error so need to check if it's found first.
        If Not rFoundRange Is Nothing Then
            AllocateNamedRange ThisWorkbook, rFoundRange.Offset(0, 2).Value, _
                "=VERSCHUIVING(archief!$A$2;0;0;1;AANTALARG(archief!$A$3:$Y$3))", "A1"
        End If

    End With

End Sub

'---------------------------------------------------------------------------------------
' Procedure : AllocateNamedRange
' Purpose   : Deletes the named range if it already exists and then recreates it.
'---------------------------------------------------------------------------------------
Public Sub AllocateNamedRange(Book As Workbook, sName As String, sRefersTo As String, Optional ReferType = "R1C1")
    With Book
        If NamedRangeExists(Book, sName) Then .Names(sName).Delete
            If ReferType = "R1C1" Then
                .Names.Add Name:=sName, RefersToR1C1:=sRefersTo
        ElseIf ReferType = "A1" Then
                .Names.Add Name:=sName, RefersTo:=sRefersTo
        End If
    End With
End Sub

'---------------------------------------------------------------------------------------
' Procedure : NamedRangeExists
' Purpose   : Checks if a named range exists.  Returns TRUE or FALSE.
'---------------------------------------------------------------------------------------
Public Function NamedRangeExists(Book As Workbook, sName As String) As Boolean
    On Error Resume Next
        NamedRangeExists = Book.Names(sName).Index <> (Err.Number = 0)
    On Error GoTo 0
End Function

子测试（）
AllocateNameRange This工作簿，“SomeName”，“=VERSCHUIVING（archief！$A$2；0；0；1；AANTALARG（archief！$A$3:$Y$3）），“A1”
"英文版:
'AllocateNameRange ThisWorkbook，“SomeName”，“=OFFSET（archief！$A$2,0,0,1，COUNTA（archief！$A$3:$Y$3）），“A1”
端接头
子测试2（）
'使用一些代码查找名称。
Dim rFoundRange作为范围
使用此工作簿。工作表（“Sheet1”）。范围（“MDM_MDM_工具列表”）
设置rFoundRange=.Find（什么：=源\u 1\u条件）
'如果找不到Source_1_条件，它将抛出一个错误，因此需要先检查是否找到了它。
如果不是rFoundRange，则为Nothing
AllocateNameRange ThisWorkbook，rFoundRange.Offset（0，2）.Value_
=VERSCHUIVING（archief！$A$2；0；0；1；AANTALARG（archief！$A$3:$Y$3）），“A1”
如果结束
以
端接头
'---------------------------------------------------------------------------------------
'过程：AllocateNamedRange
'目的：删除已存在的命名范围，然后重新创建它。
'---------------------------------------------------------------------------------------
Public Sub-allocateNameRange（书本作为工作簿，sName作为字符串，sRefersTo作为字符串，可选refereType=“R1C1”）
带书
如果namedrange存在（Book，sName），那么.Names（sName）.Delete
如果referetype=“R1C1”，则
.Names.Add Name:=sName，referestor1c1:=sRefersTo
ElseIf refereType=“A1”则
.Names.Add Name:=sName，referesto:=sRefersTo
如果结束
以
端接头
'---------------------------------------------------------------------------------------
'过程：NamedRange存在
'目的：检查命名范围是否存在。返回TRUE或FALSE。
'---------------------------------------------------------------------------------------
公共函数NamedRangeExists（Book作为工作簿，sName作为字符串）为布尔值
出错时继续下一步
NamedRangeExists=Book.Names（sName.Index）（Err.Number=0）
错误转到0
端函数

---

您只需将公式硬编码到指定的范围内，它将在您添加新数据时自动调整（基本上就是我的代码所做的）。

错误是什么？错误是1004，这是一个很好的完整答案+谢谢你的回答，但我不想硬编码。我想让他从工作簿中的单元格中获取公式。因此，我也可以将此程序用于其他项目，而无需更改代码。因此，当我改变标签时，它将只使用相同的代码，但根据标签中的公式，使用其他范围，但我喜欢这个代码！！！我可以使用if作为此程序中的另一个选项，您可以这样做-让代码将公式的结果分配给指定的范围：

AllocateNamedRange ThisWorkbook，“SomeName”，ThisWorkbook.Worksheets（“archief”）.range（“E6”）.Value，“A1”

我保留了

Value

，以确保完整性。它是默认属性，因此不需要包含。您也可以让它使用公式

AllocateNamedRange ThisWorkbook，“SomeName”，ThisWorkbook.Worksheets（“archief”）.Range（“E6”）.formula，“A1”

，尽管公式应该包括所有必需的工作表引用，或者它将查看当前活动的工作表。很抱歉，我仍然收到1004错误；（当我放置一个新公式时，它确实起作用……但是我没有得到所需的结果