VBA Excel：修改dynamic命名范围代码
新手问题：我有模块， 最初由Roger Govier制作 。
它使用一个input单元header并为位于header下的非空单元格创build一个dynamic命名范围。 创build的命名范围将被标记为标题单元格的值。
Private Sub CreateNamedRange(header As range) Dim wb As Workbook Dim WS As Worksheet Dim rStartCell As range Dim rData As range Dim rCol As range Dim lCol As Long Dim sSheet As String Dim Rowno As Long ' get table location Set rStartCell = header Set WS = rStartCell.Worksheet Set wb = WS.Parent sSheet = "'" & WS.Name & "'" With rStartCell Rowno = .row Set rData = .CurrentRegion End With Set rData = WS.range(rStartCell, WS.Cells(Rowno, rStartCell.Column)) Set rCol = rData.Columns lCol = rCol.Column wb.Names.Add Name:=Replace(rCol.Cells(1).Value, " ", "_"), _ RefersToR1C1:="=" & sSheet & "!" & rCol.Cells(2).Address(ReferenceStyle:=xlR1C1) & ":INDEX(C" & lCol & ",LOOKUP(2,1/(C" & lCol & "<>""""),ROW(C" & lCol & ")))" End Sub
我想修改这个代码，以便不是创build一个命名范围，而是只返回那个命名范围的范围。
示例：我们在A1有一个标题，在A2:A5数据。
现在：如果我们调用CreateNamedRange(.range("A1")) ，它为A2:A5创build一个dynamic命名范围。
目标：如果我们调用CreateNamedRange(.range("A1"))它返回.range("A2:A5")到VBA代码中的一个variables：
dim myRange As Range set myRange = CreateNamedRange(.range("A1"))
首先你应该注意的是，Subs不返回任何值，因此myRange = CreateNamedRange(.range("A1"))没有任何意义（与你的Sub;它在这个答案中的函数是有意义的）。
下面的函数返回一个范围，在与input范围相同的列中，从下一行开始，包括下面的所有行，直到find一个空白单元格。 这个范围被称为“anyName”（因此你可以通过Range("anyName")来访问它）。
Private Function CreateNamedRange(header As Range) As Range Dim curRow As Long: curRow = header.Row + 1 Set tempRange = header.Worksheet.Cells(curRow, header.Column) Do While (Not IsEmpty(tempRange)) curRow = curRow + 1 Set tempRange = header.Worksheet.Cells(curRow, header.Column) Loop Set CreateNamedRange = header.Worksheet.Range(header.Worksheet.Cells(header.Row + 1, header.Column), header.Worksheet.Cells(curRow, header.Column)) CreateNamedRange.Name = "anyName" End Function
如果你已经有开始单元格被激活，你可以使用
Set myRange = Range(ActiveCell.Address, ActiveCell.Offset.End(xlDown).Address)
为活动单元下的所有条目设置范围。 如果你没有激活它，你可以使用你的rstartCell引用和偏移量
Set myRange = Range(rStartCell.Offset(1), rStartCell.Offset(1).Offset.End(xlDown).Address)
然后你可以在下一行添加命名的范围