多条件求和

leon小鱼 · 发表于 2017-12-20 13:07

wangxml 发表于 2017-12-20 12:22
Public Function itemFilter()
Dim rng As Range, rngSelect As Range, iRowMax As Long
With Sheets(" ...

大神，你这是写了一个自定义的函数是吧

leon小鱼 · 发表于 2017-12-20 13:12

wangxml 发表于 2017-12-20 12:22
Public Function itemFilter()
Dim rng As Range, rngSelect As Range, iRowMax As Long
With Sheets(" ...

具体怎么使用?

wangxml · 发表于 2017-12-20 15:33

leon小鱼发表于 2017-12-20 13:12
具体怎么使用?

Option Explicit
Sub main()
With Sheets("报表")
Dim iRow As Integer, iCol As Integer
For iRow = 2 To 12
For iCol = 7 To 11
If iRow = 8 Then
Else
Dim strID As String, strDate As String
strID = .Cells(iRow, 3).Value
If iCol = 6 Then
strDate = Split(CStr(Sheets("报表").Cells(1, iCol).Value), "售")(1)
Else
strDate = Split(CStr(.Cells(1, iCol).Value), " 星")(0)
End If
Call itemFilter(strID, strDate, iRow, iCol)
End If
Next iCol
Next iRow
End With
End Sub
Public Function itemFilter(ByVal siteID As String, ByVal saleDate As String, ByVal iRow As Integer, ByVal iCol As Integer)
'Public Function itemFilter()
Dim rng As Range, rngSelect As Range, iRowMax As Long
With Sheets("源数据")
iRowMax = .Range("A2").End(xlDown).Row
Set rng = .Range(.Cells(1, 1), .Cells(iRowMax, 3))
'打开筛选
rng.AutoFilter Field:=1, Criteria1:=siteID '"S200005A"
rng.AutoFilter Field:=3, Criteria1:=saleDate '"2017/12/5"
'设置可见区域
Set rngSelect = rng.SpecialCells(xlCellTypeVisible)
Dim rngSelectRowMax As Long
rngSelectRowMax = .Range("A1048576").End(xlUp).Row
'计算
Sheets("报表").Cells(iRow, iCol).Formula = "=Subtotal(109,'源数据'!H2:" & .Cells(rngSelectRowMax, 8).Address & ")"
Sheets("报表").Cells(iRow, iCol).Value = Sheets("报表").Cells(iRow, iCol).Value
'关闭筛选
rng.AutoFilter
End With
End Function

复制代码

wangxml · 发表于 2017-12-20 16:01

Alt+F11
复制代码至"ThisWorkbook"
F5

leon小鱼 · 发表于 2017-12-20 17:57

wangxml 发表于 2017-12-20 16:01
Alt+F11
复制代码至"ThisWorkbook"
F5

结果出来是0，，不知道哪里出错了

2801959927 · 发表于 2017-12-20 20:40

尝试使用数据透视表，不完全符合需要，仅做参考。

Option Explicit
'######################################
'根据源数据的销售，匹配日期和店铺编号，建立数据透视表
'######################################
Sub Main()
On Error Resume Next
'行总计，行循环因子，一区店名循环因子，二区店名循环因子
'一区门店名列表，二区门店名列表，门店名长列表
Dim RowsCount&, row&, YiQu_i%, ErQu_i%, YiQuMenDianMing(), ErQuMenDianming(), MenDianMingCheng()
'该门店是否属于一区
Dim IsYiQu As Boolean
'获取行总计和门店名长列表
Sheet2.Activate
RowsCount = Range("A1").End(xlDown).row
MenDianMingCheng = Range("B1", [B1].End(xlDown).Address).Value
'获取一、二区门店名列表
Sheet1.Activate
YiQuMenDianMing = Range("D2", "D7").Value
ErQuMenDianming = Range("D9", "D12").Value
'创建分公司列表，全为“销售三公司”，为创建数据透视表做准备
Dim FenGongSi()
ReDim FenGongSi(1 To RowsCount, 1 To 1)
FenGongSi(1, 1) = "分公司"
For row = 2 To RowsCount
FenGongSi(row, 1) = "销售三公司"
Next row
'创建门店名&片区二维列表
Dim MenDianMing_PianQu()
ReDim MenDianMing_PianQu(1 To RowsCount, 1 To 2)
MenDianMing_PianQu(1, 1) = "门店名"
MenDianMing_PianQu(1, 2) = "片区"
'二位列表循环赋值
For row = 2 To RowsCount
'逻辑变量初始化
IsYiQu = False
'判断该店是否属于一区
'若属于则用一区为其赋值，并将逻辑变量设为真，跳出本层循环
For YiQu_i = 1 To UBound(YiQuMenDianMing)
If InStr(1, MenDianMingCheng(row, 1), YiQuMenDianMing(YiQu_i, 1)) > 0 Then
MenDianMing_PianQu(row, 1) = YiQuMenDianMing(YiQu_i, 1)
MenDianMing_PianQu(row, 2) = "宁波一区"
IsYiQu = True: Exit For
End If
Next YiQu_i
'若属于一区为真，直接跳过下面循环，进入下一次外层循环
'若不为真，则属于二区或其他，判断并赋值
For ErQu_i = 1 To UBound(ErQuMenDianming)
If IsYiQu = True Then Exit For
If InStr(1, MenDianMingCheng(row, 1), ErQuMenDianming(ErQu_i, 1)) > 0 Then
MenDianMing_PianQu(row, 1) = ErQuMenDianming(ErQu_i, 1)
MenDianMing_PianQu(row, 2) = "宁波二区"
Exit For
ElseIf ErQu_i = UBound(ErQuMenDianming) Then
MenDianMing_PianQu(row, 1) = "其他"
MenDianMing_PianQu(row, 2) = "其他"
End If
Next ErQu_i
Next row
'若相应位置已有数据，删除；重新写入
Sheet2.Activate
If [A1].End(xlToRight).Value = "分公司" Then
Range([A1].End(xlToRight).Offset(0, -2), [A1].End(xlToRight).End(xlDown)).Clear
End If
[A1].End(xlToRight).Offset(0, 1).Resize(RowsCount, 2) = MenDianMing_PianQu
[A1].End(xlToRight).Offset(0, 1).Resize(RowsCount, 1) = FenGongSi
'调用子过程，创建数据透视表
Call CreatePivotTable
End Sub
Sub CreatePivotTable()
Application.DisplayAlerts = False
Dim sht As Worksheet
For Each sht In Sheets
If sht.Name = "透视表" Then sht.Delete
Next sht
Sheets.Add , after:=Worksheets(Sheets.Count)
ActiveSheet.Name = "透视表"
ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
"源数据!$A$1:" & Sheets("源数据").Range("A1").End(xlDown).End(xlToRight).Address, Version:=4).CreatePivotTable _
TableDestination:=ActiveSheet.Name & "!R3C1", TableName:="透视表", DefaultVersion:= _
xlPivotTableVersion14
With ActiveSheet.PivotTables("透视表")
.InGridDropZones = True
.RowAxisLayout xlTabularRow
End With
With ActiveSheet.PivotTables("透视表").PivotFields("分公司")
.Orientation = xlRowField
.Position = 1
End With
With ActiveSheet.PivotTables("透视表").PivotFields("片区")
.Orientation = xlRowField
.Position = 2
End With
With ActiveSheet.PivotTables("透视表").PivotFields("门店编号")
.Orientation = xlRowField
.Position = 3
End With
With ActiveSheet.PivotTables("透视表").PivotFields("门店名")
.Orientation = xlRowField
.Position = 4
End With
With ActiveSheet.PivotTables("透视表").PivotFields("会计日期")
.Orientation = xlColumnField
.Position = 1
End With
ActiveSheet.PivotTables("透视表").AddDataField ActiveSheet.PivotTables("透视表" _
).PivotFields("销售金额"), "求和项:销售金额", xlSum
ActiveSheet.PivotTables("透视表").PivotFields("片区").PivotItems("其他"). _
ShowDetail = False
Application.DisplayAlerts = True
End Sub

复制代码

wangxml · 发表于 2017-12-20 20:42

leon小鱼发表于 2017-12-20 17:57
结果出来是0，，不知道哪里出错了

单击按钮，这下应该可以了

leon小鱼 · 发表于 2017-12-21 08:06

2801959927 发表于 2017-12-20 20:40
尝试使用数据透视表，不完全符合需要，仅做参考。

谢谢你，大神

leon小鱼 · 发表于 2017-12-21 08:22

wangxml 发表于 2017-12-20 20:42
单击按钮，这下应该可以了

试了，，还是00000

wangxml · 发表于 2017-12-21 09:47

leon小鱼发表于 2017-12-21 08:22
试了，，还是00000

我这运行正常啊

		自动登录	找回密码
密码			免费注册

[求助] 多条件求和