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

Question

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

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

在 table 中，我使用此代码来定位我需要的数据，到目前为止效果很好。

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

范围Source_1_Area的内容是

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

当我在内容中放置 =archief!$A$2 时，我使用的代码确实有效

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

Answer 1

这将使用您在命名范围内提供的公式

Sub Test()

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

    'English version:
    'AllocateNamedRange ThisWorkbook, "SomeName", "=OFFSET(archief!$A,0,0,1,COUNTA(archief!$A:$Y))", "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;0;0;1;AANTALARG(archief!$A:$Y))", "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

您可以将公式硬编码到命名范围内，它会在您添加新数据时自动调整（基本上是我的代码所做的）。

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

Excel VBA create a Named range from formula in worksheet

excel

excel-formula

excel-2016

vba