VBA实战技巧12： 仅显示组成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