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

新手问题：我有模块

它使用输入单元格

标题

，并为位于

标题

下的非空单元格创建动态命名范围。创建的命名范围将标记为标题单元格的值

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

---

如果已经激活了起始单元格，则可以使用

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

设置活动单元格下所有项目的范围。如果您没有激活它，您可以使用带有偏移量的rstartCell引用

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

---

然后，您可以在下一行中添加命名范围，您应该注意的第一件事是Sub不返回任何值，因此

myRange=CreateNamedRange（.range（“A1”））

没有任何意义（对于Sub；对于这个答案中的函数，它是有意义的）

下面的函数返回一个范围，该范围与输入范围在同一列中，从下一行开始，包括下面的所有范围，直到找到一个空白单元格。此范围称为“anyName”（因此您可以通过

range（“anyName”）

访问它）

---

返回到哪里。。。在单元格中，在对话框中？对于vba代码中的变量，我将在说明中添加一个说明。

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

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