vba Excel 在工作表中列出命名范围并获取值

Excel listing named range in a worksheet and get the value

提问by Arief

How to obtain a list of named range exist in a specific worksheet that start with particular string (for example all named range that start with total) and grab the value? I am trying to do Sub Total and Grand Total of accommodation cost based on the date. I will assign an unique name for each Sub Total based on the Date group. Then, I have a button that need to be clicked when it finishes to calculate the Grand Total based on the Named Range that I've assigned uniquely to each Sub Total.

如何获取以特定字符串开头的特定工作表中存在的命名范围列表（例如，所有以总计开头的命名范围）并获取值？我正在尝试根据日期对住宿费用进行小计和总计。我将根据日期组为每个小计分配一个唯一的名称。然后，我有一个按钮，当它完成时需要单击该按钮，以根据我唯一分配给每个小计的命名范围计算总计。

Below is the code I wrote to do the Grand Total:

下面是我写的做总计的代码：

Sub btnTotal()

    Dim Total, LastRowNo As Long

    LastRowNo = ActiveSheet.UsedRange.Row + ActiveSheet.UsedRange.Rows.Count

    Total = 0

    For Each N In ActiveWorkbook.Names
        Total = Total + IntFlight.Range(N.Name).Value
    Next N

    IntFlight.Range("$P" & LastRowNo).Select
    Selection.NumberFormat = "$* #,##0.00;$* (#,##0.00);$* ""-""??;@"
    With Selection
        .Font.Bold = True
    End With

    ActiveCell.FormulaR1C1 = Total

End Sub

Note: the IntFlight from "Total = Total + IntFlight.Range(N.Name).Value" is the name of my worksheet.

注意：“Total = Total + IntFlight.Range(N.Name).Value”中的 IntFlight 是我的工作表的名称。

The only problem with above code, it will looking all named range exist in the workbook. I just need to find named range exist in one particular worksheet, which start with given string and the row number (total26: means Sub Total from row 26) and then grab the value to be sum-ed as Grand Total.

上面代码的唯一问题是，它将查找工作簿中存在的所有命名范围。我只需要在一个特定的工作表中找到命名范围，它以给定的字符串和行号开头（total26：表示第 26 行的子总计），然后获取要求和的值作为总计。

Any ideas how to do this? Been spending 2 days to find the answer.

任何想法如何做到这一点？花了2天时间才找到答案。

Thanks heaps in advance.

提前致谢。

EDIT 1 (Solution Provided by Charles Williams with help from belisarius):

编辑 1（解决方案由 Charles Williams 在 belisarius 的帮助下提供）：

This is what I have done with the code from Charles Williams:

这是我对 Charles Williams 的代码所做的：

Option Explicit
Option Compare Text

Sub btnIntFlightsGrandTotal()

    Dim Total, LastRowNo As Long
    LastRowNo = FindLastRowNo("International Flights")

    Dim oNM As Name
    Dim oSht As Worksheet
    Dim strStartString As String

    strStartString = "IntFlightsTotal"
    Set oSht = Worksheets("International Flights")

    For Each oNM In ActiveWorkbook.Names
        If oNM.Name Like strStartString & "*" Then
            If IsNameRefertoSheet(oSht, oNM) Then
                Total = Total + Worksheets("International Flights").Range(oNM.Name).Value
            End If
        End If
    Next oNM

    IntFlights.Range("$P" & LastRowNo).Select
    Selection.NumberFormat = "$* #,##0.00;$* (#,##0.00);$* ""-""??;@"
    With Selection
        .Font.Bold = True
    End With

    ActiveCell.FormulaR1C1 = Total

End Sub

Function FindLastRowNo(SheetName As String) As Long

    Dim oSheet As Worksheet
    Set oSheet = Worksheets(SheetName)

    FindLastRowNo = oSheet.UsedRange.Row + oSheet.UsedRange.Rows.Count

End Function

Thank you all for your help. Now, I need to come up with my own version for this script.

谢谢大家的帮助。现在，我需要为这个脚本想出我自己的版本。

回答by Charles Williams

Here is some code that checks if a Defined Name starts with a string and refers to a range within the used range of a given worksheet and workbook.

下面是一些代码，用于检查定义的名称是否以字符串开头并引用给定工作表和工作簿的使用范围内的范围。

Option Explicit
Option Compare Text
Sub FindNames()
    Dim oNM As Name
    Dim oSht As Worksheet
    Dim strStartString As String

    strStartString = "Total"
    Set oSht = Worksheets("TestSheet")

    For Each oNM In ActiveWorkbook.Names
        If oNM.Name Like strStartString & "*" Then
            If IsNameRefertoSheet(oSht, oNM) Then

                MsgBox oNM.Name
            End If
        End If
    Next oNM
End Sub

Function IsNameRefertoSheet(oSht As Worksheet, oNM As Name) As Boolean
    Dim oSheetRange As Range

    IsNameRefertoSheet = False
    On Error GoTo GoExit

    If Not oSht Is Nothing Then
        If Range(oNM.Name).Parent.Name = oSht.Name And _
           Range(oNM.Name).Parent.Parent.Name = oSht.Parent.Name Then
            Set oSheetRange = oSht.Range("A1").Resize(oSht.UsedRange.Row + oSht.UsedRange.Rows.Count - 1, oSht.UsedRange.Column + oSht.UsedRange.Columns.Count - 1)
            If Not Intersect(Range(oNM.Name), oSheetRange) Is Nothing Then IsNameRefertoSheet = True
            Set oSheetRange = Nothing
        End If
    End If

    Exit Function
GoExit:
End Function

回答by Dr. belisarius

The following function will output all the names and their totals in your Workbook.

以下函数将输出工作簿中的所有名称及其总数。

I think it is the basic block you need to get your code running.

我认为这是让代码运行所需的基本块。

Sub btnTotal()

    For Each N In ActiveWorkbook.Names
           MsgBox N.Name + " " + CStr(Application.WorksheetFunction.Sum(Range(N)))
    Next N
End Sub

Edit

编辑

Answering your comment:

回答你的评论：

Define your names in this way:

以这种方式定义你的名字：

Then (and only then) the following code works:

然后（并且只有那时）以下代码有效：

Sub btnTotal()

  For Each N In ActiveSheet.Names
     If (InStr(N.Name, "!Total") <> 0) Then
         MsgBox N.Name + " " + CStr(Application.WorksheetFunction.Sum(Range(N)))
     End If
  Next N
End Sub

If you do not define the scope of the names correctly you need a lot of extra work in your code.

如果您没有正确定义名称的范围，则需要在代码中进行大量额外工作。

EditAs you forgot to mention that you are still working with Excel 2003, hereyou will find an addin to manage name scoping in that version. See screen cap below

编辑正如您忘记提及您仍在使用 Excel 2003，在这里您将找到一个插件来管理该版本中的名称范围。请参阅下面的屏幕截图

HTH

HTH