2013-06-26 34 views
0

我有一張包含美國國家在最上面的行,我期望每個都是一個範圍的名稱。當然,每個國家都有自己名下的獨特城市數量。動態範圍一次爲許多列命名

我想在不使用「從列表創建」選項的情況下快速輕鬆地創建這些範圍名稱(動態範圍),其中只有30個城市的州將顯示80個或更多空白...(比方說第1列至第50列,行1通100,其中100是其中具有更多的城市,國家將結束行)

不知道如果我很清楚,但任何幫助將不勝感激

+0

您將想要顯示自己編碼的嘗試,否則此問題可能會很快關閉。 – dennythecoder

回答

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將需要做出一些努力來理解和適應它。

+1

@LeymanCoder ......我不僅瞭解你的觀點並完全同意。請相信我,自從您發送信息到現在爲止,我一直在努力自己執行代碼......當然根本沒有工作......我剛回到論壇看到安德魯的迴應.. 。所以,謝謝你們倆...會嘗試你的代碼並提供反饋 – igornachov

+0

@AndrewGibson ...它的工作完美...非常感謝你的幫助 – igornachov

+0

@igornachov當然它確實:)。隨意*打勾* –

0

我有一些代碼,我曾經使用了很多(它甚至有一個用戶界面)。它爲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