从小计组创建命名范围
Posted
技术标签:
【中文标题】从小计组创建命名范围【英文标题】:Create Named Ranges from Subtotal Group 【发布时间】:2018-06-19 11:16:52 【问题描述】:我需要从添加了小计的工作表中创建命名范围。
所以如图所示,我需要使用 VBA 为所有组创建命名范围(E4:F16
如图所示)。为Column D
(“组”)中的每个更改创建小计。小计向导添加的附加行(Row 17
如图所示)不应包含在命名范围中。我总共需要创建大约 10 个类似的命名范围。
该工作表上包含数据的总行数(我将其命名为R 14
)是固定的,但组中的元素数是可变的。因此,例如,我需要代码来找出单元格 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
这就是我目前的进步。
【问题讨论】:
是否有理由需要使用命名范围而不是动态引用单元格?命名范围并不是真的打算以这种方式使用。为什么不使用 CONSTants,而不是硬编码一堆变量?此外,您还有很多不需要/效率低下的代码,例如,您的第一个函数可以完全消除,基本上替换为第二个函数中的一行,something 比如:With ThisWorkbook.Worksheets("R 14"): ThisWorkbook.Names.Add Name:="R 14_" & counter, RefersTo:=.Range(.Cells(myFirstRow, myFirstColumn), .Cells(myLastRow, myLastColumn)): End With
这些范围内的数据必须在其他地方自动处理:我有多个其他部分必须从特定组中获取数据并对其执行大量计算。当然,我可以手动完成,但我有 5 张这样的表格,每张平均 10 组,并且必须每天为超过 30 个元素的每个人执行此操作。抱歉编码不好,但我写 VBA 不到一周。
【参考方案1】:
您可以使用Range
对象的Areas
属性并将所有内容归结为:
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
注意:Format(counter, "00")
的最后两位数字格式为“_01”、“_02”等。
【讨论】:
像魅力一样工作!非常感谢!我欠你一个;)以上是关于从小计组创建命名范围的主要内容,如果未能解决你的问题,请参考以下文章