计算百分比并在另一个Excel工作表中填充结果

Question

我需要帮助创建一个宏/ vba来从名为“database”的excel数据库进行查询，以匹配“Results”中的多个条件并计算百分比并填充一列。

https://docs.google.com/file/d/0ByCB_rXHlkEba05RU3p5RGlnM1U/edit?pli=1

工作表 - “数据库”

Fields:
YEAR 
Region# 
Region_Name 
Store#  
Store_NAME  
ITM-GRADE   
Whse    
Item#   
Item_Desc   
Type    
Group   
Qty

Worksheeet =“结果”

Criteria        Year      2005      2005      2005   2005
Criteria        ITM-GRADE GradeA1   GradeA1   GradeA1    GradeA1
Criteria        Whse      Whse2     Whse2     Whse2  Whse2
Criteria        Group     11 to 44  11        55 to 66   55 to 66
Criteria        Type      Q1        Q2        Q1     Q2

Region# Store#  percentage          
1001    1001-002    Group 11-44 divided by Group 11-66          
1001    1001-003    %   %   %   %
1001    1001-004    %   %   %   %
1003    1003-001    %   %   %   %
1003    1003-002    %   %   %   %
1003    1003-003    %   %   %   %
1005    1005-001    %   %   %   %

将区域＃，商店＃，年份，ITM级别，白色，组别，类型与“数据库”匹配，将第11-44组除以第11-66组，并填写每列中的百分比。谢谢你的帮助。

Answer 1

假设您已经拥有有效的公式，只需要进行一些修补，这个解决方案对您有用：

Set ArrayFormula to many Excel cells using VBA

但是，您的公式超过255个字符，这将导致1004错误。

您可以使用命名范围大大缩小此公式。

<强>更新

不是使用讨厌的数组公式，IMO可能更好，更容易在数据库范围内自动使用AutoFilter方法，然后使用SpecialCells(xlCellTypeVisible)列中的QTY计算分子和等式的分母，计算内存中的分数，然后写入工作表单元格。

此方法似乎返回与数组公式相同的结果，并且还允许多个“组”条件，您的公式不允许这样做。

Using the updated file，插入普通代码模块并粘贴以下代码：

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＆amp;列中的条件字段。 H，因为它们在更新的XLSM文件中无效。