Question

新手问题：我有模块，originally made by Roger Govier。

它使用输入单元格header，并为位于header下的非空单元格创建动态命名范围。创建的命名范围将标记为标题单元格的值。

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

我想修改这段代码，以便它不会创建一个命名范围，而只返回指定范围内的返回值。

实施例：我们在A1中有一个标头，在A2:A5中有数据。

现在：如果我们致电CreateNamedRange(.range("A1"))，它会为A2:A5创建动态命名范围。

目标：如果我们调用CreateNamedRange(.range("A1"))，它会将.range("A2:A5")返回给VBA代码中的变量：

dim myRange As Range
set myRange = CreateNamedRange(.range("A1"))

Answer 1

首先要注意的是，Subs不会返回任何值，因此myRange = CreateNamedRange(.range("A1"))没有任何意义（使用你的Sub;它对这个答案中的函数有意义）。

下面的函数返回一个范围，在与输入范围相同的列中，从下一行开始，包括下面的所有列，直到找到一个空白单元格。此范围称为“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

Answer 2

如果您已经启动了开始单元格，则可以使用

Set myRange = Range(ActiveCell.Address, ActiveCell.Offset.End(xlDown).Address)

为活动单元格下方的所有条目设置范围。如果您没有激活它，您可以使用带有偏移的rstartCell参考

Set myRange = Range(rStartCell.Offset(1), rStartCell.Offset(1).Offset.End(xlDown).Address)

然后你可以在下一行添加命名范围

VBA Excel：修改动态命名范围代码

2 个答案: