Vba 从小计组创建命名范围

我需要从已添加小计的工作表中创建命名范围

因此，如图所示，我需要使用VBA为所有组创建命名范围（

E4:F16

如图所示）。小计是为

列D

（“组”）中的每项变更创建的。小计向导添加的其他行（

第17行

，如图所示）不应包含在命名范围内。我需要总共创建大约10个类似的命名范围

该表中包含数据的行总数（我将其命名为

R14

）是固定的，但组中元素的数量是可变的。例如，我需要代码来发现单元格

A17

为空，并创建一个命名范围

E4:F16。

到目前为止，我成功创建了一个公共函数，该函数可以在给定起始行、结束行、起始列和结束列的情况下创建命名范围：

Public Function createNamedRangeDynamic_1(sheetName As String, _
    myFirstRow As Long, _
    myLastRow As Long, _
    myFirstColumn As Long, _
    myLastColumn As Long, _
    counter As Integer)

    Dim myWorksheet As Worksheet
    Dim myNamedRangeDynamic As Range 'declare object variable to hold reference to cell range
    Dim myRangeName As String 'declare variable to hold defined name

    Set myWorksheet = ThisWorkbook.Worksheets(sheetName) 'identify worksheet containing cell range
    myRangeName = sheetName & "_" & counter 'specify defined name

    With myWorksheet.Cells
        Set myNamedRangeDynamic = .Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn)) 'specify cell range
    End With
    ThisWorkbook.Names.Add Name:=myRangeName, RefersTo:=myNamedRangeDynamic 'create named range with workbook scope. Defined name is as specified. Cell range is as identified, with the last row and column being dynamically determined
End Function

我的问题是，我无法生成任何类型的子例程来使用上述代码生成命名范围。我尝试了以下方法：

Sub makeRanges()
    Dim sheetName As String
    Dim firstRow As Long
    Dim nextRow As Long
    Dim lastRow As Long 'the lowest row of the group/range
    Dim endRow As Long 'the last row with data on the sheet
    Dim firstCol As Long
    Dim lastCol As Long
    Dim cell As Range
    Dim myWorksheet As Worksheet
    Dim counter As Integer

    sheetName = "R 14"
    firstCol = 5
    lastCol = 6
    groupNum = 9
    fistRow = 4
    endRow = 147
    counter = 1

    Set myWorksheet = ThisWorkbook.Worksheets(sheetName)

    With myWorksheet.Cells
        For Each cell In .Range("A" & firstRow, "A" & endRow)
            If cell.Value = "" Then
                nextRow = cell.Row
                Exit For
            End If
        Next cell

        lastRow = nextRow - 1

        Call createNamedRangeDynamic_1(sheetName, _
            firstRow, _
            lastRow, _
            firstCol, _
            lastCol, _
            counter) ' create named range

        firstRow = nextRow + 1
        counter = counter + 1
    End With
End Sub

---

这就是我到目前为止的进展。

您可以使用

范围

对象的

区域

属性，并将所有这些归结为：

Option Explicit

Sub makeRanges()
    Dim sheetName As String, sheetNameForNamedRange as String
    Dim counter As Long

    sheetName = "R 14"
    sheetNameForNamedRange = Replace(sheetName, " ", "_")  ' named range name doesn't accept blanks

    Dim area As Range
    With ThisWorkbook 'reference wanted workbook
        For Each area In .Worksheets(sheetName).Range("A4:A147").SpecialCells(xlCellTypeConstants).Areas ' loop through areas of the not empty cell range along column A in 'sheetName' sheet of referenced workbook
            counter = counter + 1 ' update counter
            .Names.Add Name:=sheetNameForNamedRange & "_" & Format(counter, "00"), RefersTo:=area.Offset(, 4).Resize(, 2) ' add current named range as current area offset 4 columns to the right and wide two columns
        Next
    End With
End Sub

---

注：

格式（计数器，“00”）

将最后两位数字作为格式“\u 01”\u 02“，等等。

是否有理由使用命名范围而不是动态引用单元格？命名范围实际上并不打算以这种方式使用。与其硬编码一堆变量，为什么不使用常量呢？此外，您还有许多不需要的/低效的代码，例如，您的第一个函数可能会被完全删除，替换为第二个函数中基本上只有一行，类似于：

与ThisWorkbook.Worksheets（“R14”）：ThisWorkbook.Names.Add Name:=“R14_”&counter，referesto:=.Range（.Cells（myFirstRow，myFirstColumn），.Cells（myLastRow，myLastColumn））：以

结束这些范围内的数据必须在其他地方自动处理：我有多个其他部分，必须从特定组中获取数据并对其执行大量计算。当然，我可以手动完成这些操作，但我有5张这样的表，平均每张表10组，并且必须为每个人每天都有超过30个元素。很抱歉，编码不好，但我写VBA还不到一周。效果很好！非常感谢！我欠你一个；）