我初步的理解是，我或许可以用Union来解决这个问题：
我在工作簿的不同页面上为各种产品类型设置了不同的动态命名范围。所有这些都带有相同的起始单元格和列属性，但长度会根据输入数据而有所不同。有没有一种简单的方法可以将这些条目自动汇集到一个综合列表中？这些不是格式化的表格，我宁愿避免将它们制成图表。
例如：工作表 1 包含两种产品 (B2:B3) 的列表，C 和 D 列中包含相关的收入和成本数据。工作表 2 包含三种产品 (B2:B4) 的列表，其中...喜欢使用 (B2:B6) 自动更新工作表 3，并使用原始 2 个工作表中的数据自动更新 C 和 D 列。这些数据会增长并会定期更改。
【问题讨论】：
B:D 的哪些列包含公式，哪些包含值（在 1 和 2 中）？
标签： excel vba dynamic named-ranges
这是一种模拟 UNION 的方法
=LET(
data1,FILTER('Worksheet 1'!B:D,'Worksheet 1'!B:B<>""),
data2,FILTER('Worksheet 2'!B:D,'Worksheet 2'!B:B<>""),
rows1,ROWS(data1),
rows2,ROWS(data2),
cols1,COLUMNS(data1),
rowindex,SEQUENCE(rows1+rows2),
colindex,SEQUENCE(1,cols1),
IF(
rowindex<=rows1,
INDEX(data1,rowindex,colindex),
INDEX(data2,rowindex-rows1,colindex))
)
【讨论】：
我知道我的代码可能非常低效 - 我仍处于学习的开始阶段......由于我无法弄清楚这个“联合”的东西，我最终运行了以下代码：
Sub dynamicRangeCons()
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim startCell As Range, lastRow As Long, lastCol As Long, ws0 As Worksheet, ws1 As Worksheet
Dim ConsItem As String
Set ws = Worksheets("Cons Ingredients Listing")
ws.Activate
Set startCell = ws.Range("B3")
Set ws0 = ThisWorkbook.Sheets("Cons Ingredients Listing")
Set ws1 = ThisWorkbook.Sheets("Spirits Ingredients Listing")
Set ws2 = ThisWorkbook.Sheets("Beer Ingredients Listing")
Set ws3 = ThisWorkbook.Sheets("Misc Ingredients Listing")
Set ws4 = ThisWorkbook.Sheets("Wine Ingredients Listing")
Set ws5 = ThisWorkbook.Sheets("NA Ingredients Listing")
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).End(xlToRight).Column
ws.Range(startCell, ws.Cells(lastRow, lastCol)).Clear
ws1.Range("SpiritsItem").Copy ws0.Range("B3")
ws1.Range("Spirits").Copy ws0.Range("C3")
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws2.Range("BeerItem").Copy ws.Cells(lastRow + 1, lastCol)
ws2.Range("Beer").Copy ws.Cells(lastRow + 1, lastCol + 1)
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws3.Range("MiscItem").Copy ws.Cells(lastRow + 1, lastCol)
ws3.Range("Misc").Copy ws.Cells(lastRow + 1, lastCol + 1)
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws4.Range("WineItem").Copy ws.Cells(lastRow + 1, lastCol)
ws4.Range("Wine").Copy ws.Cells(lastRow + 1, lastCol + 1)
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws5.Range("NAItem").Copy ws.Cells(lastRow + 1, lastCol)
ws5.Range("NA").Copy ws.Cells(lastRow + 1, lastCol + 1)
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).Column
ws.Range(startCell, ws.Cells(lastRow, lastCol)).Select
ThisWorkbook.Names.Add Name:="ConsItem", RefersTo:=Selection
lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
lastCol = ws.Cells(startCell.Row, startCell.Column).End(xlToRight).Column
ws.Range(ws.Cells(startCell.Row, startCell.Column + 1), ws.Cells(lastRow, lastCol)).Select
ThisWorkbook.Names.Add Name:="Cons", RefersTo:=Selection
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True
结束子
【讨论】：
Module1。Option Explicit
Sub ConsolidateProducts()
Const sNamesList As String = "Sheet1,Sheet2"
Const sFirst As String = "B2:D2"
Const dName As String = "Sheet3"
Const dFirst As String = "B2"
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim sNames() As String: sNames = Split(sNamesList, ",")
Dim nUpper As Long: nUpper = UBound(sNames)
Dim nCount As Long: nCount = -1
Dim sData As Variant: ReDim sData(0 To nUpper)
Dim rData() As Long: ReDim rData(0 To nUpper)
Dim sws As Worksheet
Dim srg As Range
Dim sfrrg As Range
Dim slCell As Range
Dim srCount As Long
Dim drCount As Long
Dim n As Long
For n = 0 To nUpper
Set sws = wb.Worksheets(sNames(n))
Set sfrrg = sws.Range(sFirst)
Set slCell = Nothing
Set slCell = sfrrg.Resize(sws.Rows.Count - sfrrg.Row + 1) _
.Find("*", , xlFormulas, , xlByRows, xlPrevious)
If Not slCell Is Nothing Then
nCount = nCount + 1
srCount = slCell.Row - sfrrg.Row + 1
Set srg = sfrrg.Resize(srCount)
sData(nCount) = srg.Value
rData(nCount) = srCount
drCount = drCount + srCount
End If
Next n
If nCount = -1 Then Exit Sub
Dim cCount As Long: cCount = sfrrg.Columns.Count
Dim dData As Variant: ReDim dData(1 To drCount, 1 To cCount)
Dim s As Long, d As Long, c As Long
For n = 0 To nCount
For s = 1 To rData(n)
d = d + 1
For c = 1 To cCount
dData(d, c) = sData(n)(s, c)
Next c
Next s
Next n
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim dfCell As Range: Set dfCell = dws.Range(dFirst)
Dim dfrrg As Range: Set dfrrg = dfCell.Resize(, cCount)
Dim drg As Range: Set drg = dfrrg.Resize(drCount)
drg.Value = dData
Dim dcrg As Range: Set dcrg = dfrrg _
.Resize(dws.Rows.Count - dfrrg.Row - drCount - 1).Offset(drCount)
dcrg.ClearContents
End Sub
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const sFirst As String = "B2:D2"
Dim srg As Range
With Range(sFirst)
Set srg = .Resize(Rows.Count - .Row + 1)
End With
Dim irg As Range
Set irg = Intersect(srg, Target)
If Not srg Is Nothing Then
ConsolidateProducts
End If
End Sub
【讨论】：