用VBA在EXCEL中实现多条件筛选,并对满足条件的,进行某栏位的统计(不用ADO)对某表或表的一个区域进行多条件筛选,并对满足条件的,进行某栏位的统计做如下形式的函数:SheetSumByMultiCondition(参数1=表名,参数2=要统计的栏位名,参数3=条件1的栏位名,参数4=条件1的具体条件,参数5=条件2的栏位名,参数6=条件2的具体条件,参数7=条件3的栏位名,参数8=条件3的具体条件)
如:SheetSumByMultiCondition("Sheet1",Field3Name,Field1Name,"<=200",Field4Name,"<2005/3/3",Field5Name,"=abc")   RangeSumByMultiCondition(参数1=Range的范围值,参数2=要统计的栏位名,参数3=条件1的栏位名,参数4=条件1的具体条件,参数5=条件2的栏位名,参数6=条件2的具体条件,参数7=条件3的栏位名,参数8=条件3的具体条件)
SheetSumByMultiCondition(A2:G5,Field3Name,Field1Name,"<=200",Field4Name,"<2005/3/3",Field5Name,"=abc")
请问用以上函数格式,要怎么实现筛选统计(不用ADO)

解决方案 »

  1.   

    Sub aa()
        Dim a As Range
        Dim i As Long
        Dim j As Long
        
        Dim Rows As Long
        Dim Cols As Long
        
        Set a = Sheet1.Range("A3:B8")
        
        Rows = a.Rows.Count
        Cols = a.Columns.Count
        
        Debug.Print Rows, Cols
        
        For i = 1 To Rows
             For j = 1 To Cols
                  a.Cells(i, j).Value = i * j
             Next
        Next
        
        Set a = Nothing
    End Sub
      

  2.   

    Public Enum Signer
           等于 = 1
           小于 = 2
           大于 = 3
           小于等于 = 4
           大于等于 = 5
           不等于 = 6
    End EnumPublic Function GetSumByRangeCondition(CurRange As Range, _
                                            SumField As String, _
                                            Field1 As String, _
                                            Condition1 As Signer, _
                                            Value1 As Variant, _
                                            Field2 As String, _
                                            Condition2 As Signer, _
                                            Value2 As Variant) As Long
            On Error GoTo err1
            
            Dim i As Long
            Dim j As Long
            Dim lngSum As Long '累积的总和
            Dim Rows As Long '总行数
            Dim Cols As Long '总列数
            Dim Field1Pos As Long '条件1所在的列号
            Dim Field2Pos As Long '条件2所在的列号
            Dim SumFieldPos As Long '求和字段的列号
            
            Dim Field1Value As Variant
            Dim Field2Value As Variant
            
            Rows = CurRange.Rows.Count
            Cols = CurRange.Columns.Count
            
            For i = 1 To Cols
                 If CurRange.Cells(1, i).Value = Field1 Then
                        Field1Pos = i
                 End If
                 If CurRange.Cells(1, i).Value = Field2 Then
                        Field2Pos = i
                 End If
                 If CurRange.Cells(1, i).Value = SumField Then
                        SumFieldPos = i
                 End If
            Next
            
            
            For i = 2 To Rows
                 Field1Value = CurRange.Cells(i, Field1Pos).Value
                 Field2Value = CurRange.Cells(i, Field2Pos).Value
                 
                 If CompareValue(Field1Value, Value1, Condition1) = True And CompareValue(Field2Value, Value2, Condition2) = True Then
                        lngSum = lngSum + CLng(CurRange.Cells(i, SumFieldPos).Value)
                 End If
            Next
            
            GetSumByRangeCondition = lngSum
            
            Exit Function
    err1:
            MsgBox Err.Description, vbInformation + vbOKOnly, "系统提示"
            Err.Clear
            GetSumByRangeCondition = 0
    End Function
    Private Function CompareValue(Value1 As Variant, Value2 As Variant, cSigner As Signer) As Boolean
            On Error GoTo err1
            
            Select Case cSigner
                   Case 等于
                            If Value1 = Value2 Then
                                   CompareValue = True: Exit Function
                            End If
                   Case 不等于
                            If Value1 <> Value2 Then
                                   CompareValue = True: Exit Function
                            End If
                   Case 小于
                            If Value1 < Value2 Then
                                   CompareValue = True: Exit Function
                            End If
                   Case 大于
                            If Value1 > Value2 Then
                                   CompareValue = True: Exit Function
                            End If
                   Case 小于等于
                            If Value1 <= Value2 Then
                                   CompareValue = True: Exit Function
                            End If
                   Case 大于等于
                            If Value1 >= Value2 Then
                                   CompareValue = True: Exit Function
                            End If
                   Case Else
                        CompareValue = False
            End Select
            
            CompareValue = False
            Exit Function
    err1:
            Debug.Print Err.Description
            Err.Clear
            CompareValue = False
    End FunctionSub aa()
      Sheet1.Range("A1").Value = GetSumByRangeCondition(Range("C4:F12"), "DD", "BB", 等于, "n", "CC", 小于等于, #1/4/2005#)
    End Sub
      

  3.   

    AAA BB CC DD
    aa y 2005-1-1 1
    bb n 2005-1-2 2
    cc y 2005-1-3 3
    dd n 2005-1-4 4
    ee y 2005-1-5 5
    ff n 2005-1-6 6
    gg n 2005-1-7 7
    hh n 2005-1-8 8
      

  4.   

    以如下数据为例:
    A B C D
    1 AAA BB CC DD
    2 aa y 2005-1-1 1
    3 aa n 2005-1-2 2
    4 aa y 2005-1-3 3
    5 aa n 2005-1-4 4
    6 aa y 2005-1-5 5
    7 aa n 2005-1-6 6
    8 aa n 2005-1-7 7
    9 aa n 2005-1-8 8实现如下:
    Private Sub test()    
        Debug.Print SheetSumByMultiCondition(Range("A1:D9"), "DD", "AAA", "=aa", "BB", "=y", "CC", ">=2005-1-1")
    End SubPrivate Function SheetSumByMultiCondition(参数1 As Range, 参数2, 参数3, 参数4, 参数5, 参数6, 参数7, 参数8) As Double
        Dim strFormula As String
        Dim varOldVals(1 To 6)
        
        Range(Cells(65534, 253), Cells(65535, 255)).NumberFormat = "@"
        Cells(65534, 253) = 参数3: Cells(65535, 253) = 参数4
        Cells(65534, 254) = 参数5: Cells(65535, 254) = 参数6
        Cells(65534, 255) = 参数7: Cells(65535, 255) = 参数8
        
        strFormula = "DSUM(" & 参数1.Address & "," & Chr(34) & 参数2 & Chr(34) & "," & Range(Cells(65534, 253), Cells(65535, 255)).Address & ")"
        SheetSumByMultiCondition = Application.Evaluate(strFormula)
        
        Cells(65534, 253) = Null: Cells(65535, 253) = Null
        Cells(65534, 254) = Null: Cells(65535, 254) = Null
        Cells(65534, 255) = Null: Cells(65535, 255) = Null
        
    End Function
      

  5.   

    555....楼上的运行出错一定要像用EXCEL的常用函数Sum..等一样的使用:(
      

  6.   

    能否通过函数,调用Form,,在Form中实现相应的功能呢?
    大家帮忙看看,感激不尽~~`
      

  7.   

    将Private改为Public,放到一个VBA的模组中。
      

  8.   

    对,但如何屏蔽EXCEL内置函数的对话框呢?
      

  9.   

    TO DawnPine(拂晓的松):就得做成在EXCEL里,方便使用的一个累计公式:(
      

  10.   

    A       B         C    D
          产品  日期       单价 数量
     1    AA    2000-6-15   1   100
     2    AA    2000-6-20   1   125
     3    BB    2000-6-30   2   150
     4    BB    2000-7-10   2   175
     5    CC    2000-7-15   3   200
     6    CC    2000-7-20   3   225
     7    AA    2000-7-30   1   250
     8    AA    2000-8-10   1   275
     9    BB    2000-8-15   2   300
    10    BB    2000-8-20   2   325
    11    CC    2000-8-30   3   350
    12    CC    2000-10-10  3   375
    13    DD    2000-10-15  4   400
    14    DD    2000-10-30  4   425假设有数据如上
    现要将产品BB8月份产值填入E2单元格在E2里填:
    =sum(if(($a$2:$a$14="BB")*(month($b$2:$b$14)=8),($c$2:$c$14)*($d$2:$d$14),0))然后按Ctrl+Shift+Enter
    公式被自动加上一对大括号{}就对了
    这时E2会显示 1250
      

  11.   

    DawnPine(拂晓的松):像参数$a$2:$a$14这些的输入,好麻烦哦:(