根据列中的值创建命名范围 [英] Creating named range based on value in column

问题描述

我想基于B列中的值创建一个命名范围.

I want to create a named range based on the value in column B.

例如

我要创建

• 名称为UNIT21的范围，并且RefersTo上方的数据应为A2:C4和A6:C6.
• 名称范围:UNIT22用于B列中具有22的数据.

1. 如何从A:C中为整个行选择整个行?
2. 如何将新数据添加到现有命名范围中，而不是像代码一样替换现有值.

Sub naming()
    Dim row_index As Long
    Dim lastrow As Long: lastrow = 5
    
    Dim NamedRange As Range
    Dim celltomap As Range
    
    Dim Rng As Range
    
    For row_index = 1 To lastrow
    
        RangeName = Sheet3.Range("A2:C6").Cells(row_index, 2).Value
        Set celltomap = Sheet3.Range("A2:C6").Cells(row_index, 3)
        
        Sheet3.Names.Add Name:="UNIT" & RangeName, RefersTo:=celltomap
     
        MsgBox ("UNIT" & RangeName)
    
    Next row_index
    
End Sub

推荐答案

运行以下代码，它将创建范围名称.

Run the below code, it will create the range names.

如果在运行代码之前未对列表进行排序，则命名范围的值将为{...}.

The value of the named ranges will be {...} if the list is unsorted before you run the code.

Sub NameRanges()

    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant
    Dim FrstRng As Range
    Dim UnionRng As Range
    Dim c As Range

    Set sh = ThisWorkbook.Sheets("Sheet1")
    With sh
        Set Rng = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
        Set cUnique = New Collection

        On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique
            For Each c In Rng.Cells
                If c = vNum Then
                    If Not UnionRng Is Nothing Then
                        Set UnionRng = Union(UnionRng, c.Offset(, 1))   'adds to the range
                    Else
                        Set UnionRng = c.Offset(, 1)
                    End If
                End If
            Next c

            UnionRng.Name = "Unit" & vNum
            Set UnionRng = Nothing
        Next vNum
    End With

End Sub

您有时可能想要删除范围名称并重新开始.

There may be a time you want to delete the range names and start over.

Sub delete_RngNames()
    Dim rn As Name
    For Each rn In ActiveWorkbook.Names
        rn.Delete
    Next rn
End Sub

您没有在工作表或UserForm上指示ActiveX组合框.

You did not indicate an ActiveX combobox on the worksheet or a UserForm.

这对两个都应该起作用，只是buttonNames可能不同.

This should work for both, just the buttonNames might be different.

Private Sub CommandButton1_Click()
    Dim s As String, rng As Range, c As Range

    s = "Unit" & Me.TextBox1

    Me.ComboBox1.Clear

    For Each c In Range(s).Cells
        Me.ComboBox1.AddItem c
    Next c

End Sub

此代码假定您已在文本框中输入了内容.结合单位"和该文本框将指示要填充组合框的范围

This code assumes you have entered something in a textbox. Combining "Unit" & the textbox will indicate what range to populate the combobox

这篇关于根据列中的值创建命名范围的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！