-1

I need help creating a macro/vba to query from an excel database called "database" to match multiple criteria in "Results" and calculate a percentage and populate in a column.

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

Worksheet - "Database"

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

Worksheeet = "Results"

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    %   %   %   %

vba to match Region#, Store#, Year, ITM-Grade, Whse, Group, Type with "Database" take Group 11-44 divided by Group 11-66 and populate the percentage in each column. Thanks for your help.

4

1 回答 1

0

假设您已经有了有效的公式,稍微修改一下这个解决方案就可以为您工作:

使用 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 文件中无效。

标准字段需要更新

于 2013-05-15T21:36:39.747 回答