VBA实战技巧12： 仅显示组成SUMIFS函数的结果的数据

excelperfect

下面的这段代码来自于TheSpreadsheetGuru.com，类似数据透视表中的双击功能，可只显示组成SUMIFS函数结果的数据。代码如下：

Sub DetailForSUMIFS() '变量声明 Dim SumRange As Range Dim CriteriaRange As Range Dim CriteriaValue As Variant Dim DataSheet As Worksheet Dim TargetCell As Range Dim FormulaString As String Dim TestExpression As String Dim objRegEx As Object Dim Match As Object Dim RegExResult As Object Dim InputArray As Variant Dim x As Integer Dim FirstField As Integer '存储当前单元格 Set TargetCell = ActiveCell '确保单元格的公式包含SUMIFS函数 If Not TargetCell.Formula Like '*SUMIFS(*' Then MsgBox '没有找到SUMIFS函数引用. 中止...' Exit Sub End If '通过正则规则分离SUMIFS函数 Set objRegEx =CreateObject('VBScript.RegExp') objRegEx.IgnoreCase = True objRegEx.Global = True objRegEx.Pattern ='''.*''' TestExpression = CStr(TargetCell.Formula) '分离'SUMIFS(' 和')'之间的文本 objRegEx.Pattern ='SUMIFS\((.*?)\)' '正则规则的结果(仅使用第一个匹配项) If objRegEx.test(TestExpression) Then Set RegExResult =objRegEx.Execute(TestExpression) If RegExResult.Count > 0 Then For Each Match In RegExResult FormulaString = Match.Value Exit For Next Match End If Else Exit Sub '正则规则没有找到任何文本 End If '通过','拆分SUMIFS函数并存储在数组变量中 FormulaString = Replace(FormulaString,'SUMIFS(', '') FormulaString = Left(FormulaString,Len(FormulaString) - 1) InputArray = Split(FormulaString,',') '确定公式中的第一个条件区域 Set CriteriaRange = Range(InputArray(1)) '提取工作表引用 With CriteriaRange Set DataSheet =Workbooks(.Parent.Parent.Name).Worksheets(.Parent.Name) End With '移除任何已存在的筛选数据并打开筛选 If DataSheet.AutoFilterMode AndDataSheet.FilterMode Then DataSheet.ShowAllData '清除筛选 ElseIf Not DataSheet.AutoFilterMode Then CriteriaRange.CurrentRegion.AutoFilter '开启筛选 End If '对源数据应用SUMIFS筛选 For x = 1 To UBound(InputArray) '确保仅看到与条件区域相关的输入 If x Mod 2 <> 0 Then '确定源数据第一列的位置 FirstField =DataSheet.Range(InputArray(x)).Column -DataSheet.AutoFilter.Range.Columns(1).Column + 1 '确定要筛选数据的条件值 CriteriaValue = Evaluate(InputArray(x +1)) DataSheet.Range(InputArray(x)).AutoFilterField:=FirstField, Criteria1:=CriteriaValue End If Next x '存储SUMIFS第一个输入 Set SumRange = Range(InputArray(0)) '选择汇总单元格区域以在Excel状态栏中显示汇总数值 Application.Goto SumRange '滚动到数据集顶部 ActiveWindow.ScrollRow = 1End Sub

下图1所示的工作表为使用SUMIF函数求得苹果的销售量之和。

图1

运行DetailForSUMIFS过程后，得到的结果如下图2所示。可以看出，仅显示了苹果的信息，其他水果的信息被隐藏了，并且在状态栏中显示了苹果销售的一些其他数值信息。

图2