Question

我有一张包含美国各州的工作表，我希望每个国家都是一个范围的名称。当然，每个州都有自己名下的独特城市数量。

我想快速轻松地创建那些范围名称（动态范围），而不使用“从列表创建”选项，其中只有30个城市的州将显示80或更多空白......（比如第1列至第50列，第1行至第100行，其中100是具有更多城市的州将结束的行

不确定我是否清楚，但任何帮助将不胜感激

Answer 1

虽然我当然同意@LaymanCoder应该展示一些编码工作，但我想发布以下内容，因为它可能对其他人有用。

Sub NameJaggedColumns()
    Dim rngTable As Range
    Dim iLastRow As Integer
    Dim rng As Range

    Set rngTable = Range("A1").CurrentRegion
    iLastRow = rngTable.Rows.Count
    For Each rng In rngTable.Columns
        Range(rng.Range("A2"), rng.Cells(iLastRow + 1).End(xlUp)) _
            .Name = rng.Range("A1")
    Next rng
End Sub

OP需要付出一些努力来理解和适应它。

Answer 2

我有一些我曾经使用过很多的代码（甚至还有一个用户界面）。它为ActiveSheet的第1行中的内容为每个单元格创建动态命名范围。它将“rng”添加到单元格的内容中以形成名称，并检查非法字符。这些和空格用下划线替换：

Sub AddDynamicNamedRanges()
Dim ws As Excel.Worksheet
Dim rngColumns As Excel.Range
Dim LastCol As Long
Dim cell As Excel.Range
Dim Prefix As String
Dim IllegalCharReplacement As String
Dim RangeName As String

Set ws = ActiveSheet
Prefix = "rng"
IllegalCharReplacement = "_"
With ws
    LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
    Set rngColumns = .Range(.Cells(1, 1), .Cells(1, LastCol))
    For Each cell In rngColumns
        If Not IsEmpty(cell) Then
            RangeName = GetCleanedName(Prefix & cell.Text, IllegalCharReplacement, True)
            .Names.Add Name:=RangeName, RefersTo:= _
                       "=Index(" & cell.EntireColumn.Address & "," & 2 & "):Index(" & cell.EntireColumn.Address & ",Max(" & 2 & ",COUNTA(" & cell.EntireColumn.Address & ")))"
        End If
    Next cell
End With
End Sub

Function GetCleanedName(ObjectName As String, Optional CharReplacement As String = "_", Optional Truncate As Boolean = True) As String
Dim NewName As String
Dim IllegalChars As String
Dim MaxLength As Long

'the "\" character escapes the Regex "reserved" characters
'x22 is double-quote
IllegalChars = "\||\^|\\|\x22|\(|\)|\[|]|\$|{|}|\-|/|`|~|!|@|#|%|&|=|;|:|<|>| "
'255 is the length limit for a legal name
MaxLength = 255
NewName = Regex_Replace(ObjectName, IllegalChars, CharReplacement, False)
If Truncate Then
    NewName = Left(NewName, MaxLength)
End If

GetCleanedName = NewName

End Function

Function Regex_Replace(strOriginal As String, strPattern As String, strReplacement, varIgnoreCase As Boolean) As String
' Function matches pattern, returns true or false
' varIgnoreCase must be TRUE (match is case insensitive) or FALSE (match is case sensitive)
' Use this string to replace double-quoted substrings - """[^""\r\n]*"""

Dim objRegExp As Object

Set objRegExp = CreateObject("Vbscript.Regexp")
With objRegExp
    .Pattern = strPattern
    .IgnoreCase = varIgnoreCase
    .Global = True
End With

Regex_Replace = objRegExp.Replace(strOriginal, strReplacement)

Set objRegExp = Nothing
End Function

一次许多列的动态范围命名

2 个答案: