[已解决]求教，在现有代码里如何加入按时间段统计？

80013025 · 发表于 2011-9-27 15:00

本帖最后由 80013025 于 2011-9-27 16:58 编辑

求教，在现有代码里如何加入按时间段统计？.

汇总数据的代码在VBA模块1里面

现有代码里加时间段统计.rar (49.74 KB, 下载次数: 97)

那么的帅 · 发表于 2011-9-27 15:26

回复 80013025 的帖子

好多代码和按钮，不知道加在哪里？请明确具体要求。

80013025 · 发表于 2011-9-27 15:53

本帖最后由 80013025 于 2011-9-27 16:25 编辑

回复那么的帅的帖子

汇总统计这个按钮，谢谢！

模块1

Sub Comm1_Click()
Call Comm2_Click '先清空
Dim intRow As Integer, t As Single
Dim ARow As Integer
t = Timer
Dim cn As New ADODB.Connection, sql As String
intRow = Sheet1.Range("C65536").End(xlUp).Row
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
sql = "select 业务员,客户区域,客户简称,货品名称,产地,类型,单价,单位,sum(0) as 折合数,sum(金额),sum(小单位数量) from [源数据库$B2:Q" & intRow & "]" & _
"GROUP BY 客户简称,业务员,客户区域,货品名称,产地,类型,单价,单位"
' where 客户简称 like '%" & Range("E3").Value & "%'"
Sheet3.Range("D5").CopyFromRecordset cn.Execute(sql) '导出数据
cn.Close
Set cn = Nothing
ARow = Sheet3.Range("D65536").End(xlUp).Row
Sheet3.Range("L5:L" & ARow).FormulaR1C1 = "=QtyWithUnit(RC[-5],RC[2])" '输入公式
MsgBox "共用时：" & (Timer - t) * 1000 & "毫秒"
End Sub

Sub Comm2_Click() '清空
With Sheet3.Range("D65536").End(xlUp)
      If .Row > 4 Then
         Rows("5:" & .Row).ClearContents
      End If
End With
End Sub

mxg825 · 发表于 2011-9-27 20:52

Sub Comm1_Click()
Call Comm2_Click '先清空
Dim intRow As Integer, t As Single
Dim ARow As Integer
t = Timer
Dim cn As New ADODB.Connection, sql As String
intRow = Sheet1.Range("C65536").End(xlUp).Row
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
sql = "select 业务员,客户区域,客户简称,货品名称,产地,类型,单价,单位,sum(0) as 折合数,sum(金额),sum(小单位数量) from [源数据库$B2:Q" & intRow & "]" & _
"WHERE 销售日期 between # " & [D1] & " # AND #" & [F1] & "# GROUP BY 客户简称,业务员,客户区域,货品名称,产地,类型,单价,单位"
' where 客户简称 like '%" & Range("E3").Value & "%'"
Sheet3.Range("D5").CopyFromRecordset cn.Execute(sql) '导出数据
cn.Close
Set cn = Nothing
ARow = Sheet3.Range("D65536").End(xlUp).Row
Sheet3.Range("L5:L" & ARow).FormulaR1C1 = "=QtyWithUnit(RC[-5],RC[2])" '输入公式
MsgBox "共用时：" & (Timer - t) * 1000 & "毫秒"
End Sub

复制代码

增加了这一句
WHERE 销售日期 between # " & [D1] & " # AND #" & [F1] & "#

80013025 · 发表于 2011-9-28 09:56

本帖最后由 80013025 于 2011-9-28 10:38 编辑

回复 mxg825 的帖子

大侠，能否再帮忙加1个判断，

1.日期条件为空，则统计全部数据
2.如选择起始日期与结束日期，在这段时间内无数据，则让L4单元格的标题不出现错误，。

mxg825 · 发表于 2011-9-28 11:55

这个最佳答案由 mxg825 给出，感谢 mxg825 的回答。

单击隐藏图章

回复 80013025 的帖子

Sub Comm1_Click()
Call Comm2_Click '先清空
Dim intRow As Integer, t As Single
Dim ARow As Integer, SQdate As String
t = Timer
Dim cn As New ADODB.Connection, sql As String
'第一个问题，日期为空时不加日期条件
If Len([D1]) > 0 And Len([F1]) > 0 Then SQdate = " WHERE 销售日期 between # " & [D1] & " # AND #" & [F1] & "#"
intRow = Sheet1.Range("C65536").End(xlUp).Row
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
sql = "select 业务员,客户区域,客户简称,货品名称,产地,类型,单价,单位,sum(0) as 折合数,sum(金额),sum(小单位数量) from [源数据库$B2:Q" & intRow & "]" & _
SQdate & " GROUP BY 客户简称,业务员,客户区域,货品名称,产地,类型,单价,单位"
' where 客户简称 like '%" & Range("E3").Value & "%'"
Sheet3.Range("D5").CopyFromRecordset cn.Execute(sql) '导出数据
cn.Close
Set cn = Nothing
ARow = Sheet3.Range("D65536").End(xlUp).Row
’第二个问题，无数据时，解决【L4 】被填充公式问题
If ARow > 4 Then Sheet3.Range("L5:L" & ARow).FormulaR1C1 = "=QtyWithUnit(RC[-5],RC[2])" '输入公式
MsgBox "共用时：" & (Timer - t) * 1000 & "毫秒"
End Sub

复制代码

80013025 · 发表于 2011-9-28 13:19

回复 mxg825 的帖子

我只想说，mxg825，你不是人，你简直就是个神！！！谢谢！

mxg825 · 发表于 2011-9-28 13:32

回复 80013025 的帖子

有这样表扬的吗？我汗死

80013025 · 发表于 2011-10-23 13:16

回复 mxg825 的帖子

mxg825老师，有空帮忙看看，把表里的代码改成这种效果！

新帖地址：
http://www.excelpx.com/thread-205001-1-1.html

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