用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)
如: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)
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
等于 = 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
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
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
大家帮忙看看,感激不尽~~`
产品 日期 单价 数量
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