从小计组创建命名范围 [英] Create Named Ranges from Subtotal Group
问题描述
我需要从添加小计的工作表中创建命名范围.
I need to create named ranges from a sheet to which I have added subtotals.
因此,如图所示,我需要使用VBA为所有组创建命名范围(如图所示的 E4:F16
).在 D列
(组")中为每次更改创建小计.小计向导添加的其他行(如图所示的 Row 17
)不应包含在命名范围内.我总共需要创建大约10个相似的命名范围.
So as shown in the picture I need to create with VBA named ranges for all the groups (E4:F16
shown on the picture). The subtotals are created for each change in Column D
("Group"). The additional rows added by the subtotal wizard (Row 17
as shown) should not be included in the named range. I need to create about 10 similar named ranges in total.
该工作表中包含数据的行总数(我将其命名为 R 14
)是固定的,但是组中元素的数量是可变的.因此,例如,我需要代码来找出 A17
单元格为空,并创建一个命名范围 E4:F16.
The total number of rows with data on that sheet (I've named it R 14
) is fixed but the number of elements within a group is variable. So for instance I need code to find out that cell A17
is empty and create a named range E4:F16.
到目前为止,我设法创建了一个公共函数,该函数可以根据给定的开始行,结束行,开始列和结束列来创建命名范围:
So far I managed to create a public function that can create a named range given start row, end row, start column and end column:
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
我的问题是,我无法创建可以使用上述代码生成命名范围的任何子例程.我尝试了以下操作:
My problem is that I can't make any kind of subroutine that can use the above code to produce the named ranges. I tried something like the following:
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
到目前为止,这就是我的进步.
So that's my progress so far.
推荐答案
您可以使用 Range
对象的 Areas
属性并将其归结为:
you can use Areas
property of Range
object and boil all that down to:
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等.
note: Format(counter, "00")
is to have last two digits as format "_01, "_02", etc..
这篇关于从小计组创建命名范围的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!