一次为多列动态范围命名答案

【问题标题】：Dynamic Range Naming for many columns at a time一次为多列动态范围命名
【发布时间】：2013-06-26 21:12:51
【问题描述】：

我在第一行有一张包含美国各州的表格，我希望每个表格都是一个范围的名称。当然，每个州都有自己名称下的唯一数量的城市。

我想在不使用“从列表创建”选项的情况下快速轻松地创建这些范围名称（动态范围），其中只有 30 个城市的州将显示 80 个或更多空白......（假设第 1 列到第 50 列，第 1 到 100 行，其中 100 是拥有更多城市的州将结束的行）

不确定我是否清楚，但我们将不胜感激

【问题讨论】：

你会想要展示自己编写一些代码的尝试，否则这个问题可能很快就会被关闭。

标签： excel vba dynamic range

【解决方案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 需要付出一些努力来理解和适应它。

【讨论】：

@LeymanCoder ...我不仅理解你的观点而且完全同意。请相信我，从您发送消息到现在我一直在尝试自己编写代码......当然根本没有工作......我刚回到论坛看到安德鲁的回复...... . 所以谢谢你们... 将尝试您的代码并提供反馈
@AndrewGibson...效果很好...非常感谢您的帮助

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

【讨论】：