使用excel中的VBA按钮创建命名为表中标题的本地命名范围

Question

我一直在尝试复制这个 VBA 按钮（遗憾的是 VBA 受密码保护）。 它被称为“名称范围与顶部”之类的东西。

您在表格中的任意位置选择一个单元格并单击按钮，它会为表格中的每一列创建一个本地命名范围（即工作表本地，而不是覆盖整个电子表格的全局命名范围），并带有顶部单元格的名称每列的，即列标题。

通过观察按下按钮后工作表中发生的情况，它看起来可以通过首先选择整个表格然后逐列选择整个表格来工作。

所以给出了表：示例表

如果我选择 B3:E8 中的任何单元格并按下按钮，它将创建命名范围：“Year”、“Sales”、“Profit”、“Loss”，它们将涵盖 B4:B8、C4:C8、D4:D8 & E4:E8 分别。

如果标题中的值或工作表名称中有空格，则会出现错误 - 这似乎是命名范围名称中没有空格的通常要求。

到目前为止，我认为我已经在 VBA 中添加了“根据选定的列创建命名范围”位，但我不知道如何让它选择整个表格，然后选择整个表格中的每一列然后将列的最高值作为名称（然后从命名范围中排除最高值）：

Sub NamedRangeSelected()
     Dim RangeName As String
      
    'specify the name of the range
     RangeName = "Name"
   
    'create named range with workbook scope
    ThisWorkbook.Names.Add Name:=RangeName, RefersTo:=Selection

End Sub

任何帮助都将不胜感激，因为它是一个非常有用的索引匹配工具，使公式更易于阅读。

Answer 1

如果列标题包含空格，下面的代码不会抛出和错误。 相反，它将用下划线替换空格。 但是，它可能会反对名称中的其他无效字符。

Sub CreateColumnRanges()
    ' 278
    
    Dim Ws          As Worksheet            ' the sheet with the table
    Dim Tbl         As ListObject
    Dim RangeName   As String
    Dim NamedRange  As Name
    Dim C           As Long                 ' loop counter: columns
    
    Set Ws = ActiveSheet                    ' change to suit
    Set Tbl = Ws.ListObjects(1)             ' refer to the first table on Ws
    With Tbl.ListColumns
        For C = 1 To .Count
            ' replace spaces in the name with underscores
            ' (remove leading/trailing blanks)
            RangeName = Replace(Trim(.Item(C).Range.Cells(1).Value), " ", "_")
            Set NamedRange = Ws.Names.Add(Name:=RangeName, _
                             RefersTo:=Tbl.DataBodyRange.Columns(C))
            NamedRange.Comment = Tbl.Name & "[" & Replace(RangeName, "_", " ") & "]"
        Next C
    End With
End Sub

该代码独立于您在工作表或表格中所做的任何选择。 您可以从“开发人员”选项卡上的“宏”菜单中选择它，从 VB 编辑器中按 F5 运行它，或者将其连接到添加到工作表的按钮。 同名的现有范围将在没有警告的情况下被新规范替换。

Answer 2

如果您不使用 ListObjects：

Sub MakeNames()
    Dim rng As Range, col, nm
    
    Set rng = Selection.CurrentRegion
    If rng.Rows.Count = 1 Then Exit Sub 'check have a usable area...
    
    For Each col In rng.Columns
        nm = Replace(col.Cells(1), " ", "_")
        ActiveSheet.Parent.Names.Add Name:=nm, _
           RefersTo:=col.Offset(1).Resize(col.Cells.Count - 1)
    Next col
End Sub