使用 Excel 中的 VBA 按钮在表中创建命名为表头的本地命名范围答案

【问题标题】：Create local named ranges named as the header in a table using a VBA button in excel使用 Excel 中的 VBA 按钮在表中创建命名为表头的本地命名范围
【发布时间】：2021-07-04 11:40:09
【问题描述】：

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

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

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

所以给定表格： example table

如果我选择 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

非常感谢任何帮助，因为它是一个非常有用的索引匹配工具，使公式更容易阅读。

【问题讨论】：

标签： excel vba

【解决方案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 运行它，或者将其连接到添加到工作表中的按钮上。现有的同名范围将被替换为新规范，而不会发出警告。

【讨论】：

【解决方案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

【讨论】：