假设您已经有了有效的公式,稍微修改一下这个解决方案就可以为您工作:
使用 VBA 将 ArrayFormula 设置为多个 Excel 单元格
但是,您的公式超过 255 个字符,这将导致 1004 错误。
您可以使用命名范围大大缩小此公式。
更新
与使用讨厌的数组公式相比,IMO 可能更好更容易地AutoFilter
在您的数据库范围内自动使用方法,然后使用列SpecialCells(xlCellTypeVisible)
中QTY
的计算公式的分子和分母,计算内存中的分数,然后写入工作表单元格。
此方法似乎返回与您的数组公式相同的结果,并且还允许您的公式不允许的多个“组”标准。
使用更新后的文件,插入普通代码模块并粘贴以下代码:
Option Explicit
Sub UsingAutoFilters()
Dim wsDB As Worksheet, wsResults As Worksheet
Dim rngResults As Range, dbRange As Range
Dim sYear$, sRegion$, sStore$, sItmGrade$, sItem$, sWhse$, sType$, sGroup$
Dim r As Long, c As Long 'row & column iterator
Dim myDenominator, myNumerator As Double 'used for calculations
Set wsDB = Worksheets("Database")
'## This is the database table ##'
Set dbRange = wsDB.Range("A1:L8043")
Set wsResults = Worksheets("QueryResult")
'## This is the range of data in the QueryResults table, E8 to the end of the data ##'
Set rngResults = wsResults.Range("E8:H13") '## Modify as needed'
'## Iterate over columns in the results table'
For c = 1 To rngResults.Columns.Count
'Capture the filter values for each COLUMN.'
With wsResults
sYear = .Cells(1, c + 4).Value
sItmGrade = .Cells(2, c + 4).Value
sWhse = .Cells(3, c + 4).Value
sItem = .Cells(4, c + 4).Value
sType = .Cells(5, c + 4).Value
sGroup = .Cells(6, c + 4).Value
End With
'## Set the filters ##'
'Filter the year
dbRange.AutoFilter Field:=1, Criteria1:=sYear
'Filter the itemgrade'
dbRange.AutoFilter Field:=6, Criteria1:=sItmGrade
'Filter the whse'
dbRange.AutoFilter Field:=7, Criteria1:=sWhse
'Filter the Item#'
dbRange.AutoFilter Field:=8, Criteria1:=sItem
'## Now, for each row in the table...'
For r = 1 To rngResults.Rows.Count
'Capture the row filter values for each ROW.'
sRegion = wsResults.Cells(r + 7, 1).Value
sStore = wsResults.Cells(r + 7, 3).Value
'## Apply the row filters ##'
'Filter the region'
dbRange.AutoFilter Field:=2, Criteria1:=sRegion
'filter the store #'
dbRange.AutoFilter Field:=4, Criteria1:=sStore
'## Calculate the denominator ##'
'SUM OF VISIBLE CELLS IN wsDB.Column L
myDenominator = Application.WorksheetFunction.Sum( _
dbRange.Columns(12).SpecialCells(xlCellTypeVisible))
'## Now, filter for the type & group, to get the Numerator'
'Filter the type'
dbRange.AutoFilter Field:=10, Criteria1:=sType
'Filter the group(s) criteria
dbRange.AutoFilter Field:=11, Criteria1:=Array(Split(sGroup, ",")), _
Operator:=xlFilterValues
'## Calculate the numerator ##'
myNumerator = Application.WorksheetFunction.Sum( _
dbRange.Columns(12).SpecialCells(xlCellTypeVisible))
If myDenominator = 0 Then
'Avoid Div/0 errors:'
rngResults(r, c).Value = "N/A"
Else:
'## get the result and place it in the cell ##'
rngResults(r, c).Value = myNumerator / myDenominator
End If
'turn off the autofilter on fields 10 & 11'
dbRange.AutoFilter Field:=10
dbRange.AutoFilter Field:=11
Next r
'turn off the autofilter'
wsDB.AutoFilterMode = False
Next c
End Sub
注意如果您有多个“组”标准(例如,您想要执行组 11 到 33),请在该单元格中使用逗号分隔的列表,即11, 22, 33
. “组”条件是唯一可以接受多个条件的字段。
注意您将需要更新列 G 和 H 中的条件字段,因为这些在更新的 XLSM 文件中无效。