Nom de plage dynamique pour plusieurs colonnes à la fois

Question

J'ai une feuille contenant les états américains dans la rangée du haut que je m'attends à ce que chacun soit le nom d'une plage. Bien sûr, chaque État a un nombre unique de villes sous son propre nom. Je veux créer rapidement et facilement ces noms de plage (plages dynamiques) sans utiliser l'option "Créer à partir de la liste" où un état avec seulement 30 villes montrera 80 blancs ou plus ... (disons les colonnes 1 à 50) , les lignes 1-100, où 100 est la ligne où l'Etat avec plus de villes se terminera)

Je ne sais pas si je suis clair, mais toute aide sera appréciée

Answer 1

Bien que je suis d'accord avec @LaymanCoder que certains codage -effort devrait être montré, je voulais poster ce qui suit, car il sera probablement utile à d'autres.

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 

L'OP devra faire des efforts pour le comprendre et l'adapter.

Answer 2

J'ai du code que j'utilisais beaucoup (il avait même une interface utilisateur). Il crée des plages nommées dynamiques pour chaque cellule dont le contenu se trouve dans la ligne 1 du code ActiveSheet. Il ajoute "rng" au contenu de la cellule pour former le nom, et vérifie également les caractères illégaux. Ces espaces et sont remplacés par un trait de soulignement:

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