EXCLE怎么用宏，实现输入起止日期，就能实现对统计表中自动查询统计数据的功能

zhang19851215

请各位高手帮助一下新人，谢谢！！！！！

MOY838840554

你记录的日期是文本格式啊，收费单的E9单元格干嘛用TEXT函数，直接=today()不就好了，然后设置单元格格式

gufengaoyue

在那个工作表中，添加 WorkSheet_Change事件，在事件里，把按日期统计的代码放这。

Private Sub Worksheet_Change(ByVal Target As Range)
if target(1).address(0,0) = "H1" then cancel=true: call 按日期统计
End Sub

zhang19851215

MOY838840554 发表于 2018-12-14 10:41
你记录的日期是文本格式啊，收费单的E9单元格干嘛用TEXT函数，直接=today()不就好了，然后设置单元格格式

主要是我想实现统计表的统计功能啊

zhang19851215

gufengaoyue 发表于 2018-12-14 10:55
在那个工作表中，添加 WorkSheet_Change事件，在事件里，把按日期统计的代码放这。

Private Sub Workshe ...

请问是在哪个工作表中？请指导

zhang19851215

静等中。。。

gufengaoyue

zhang19851215 发表于 2018-12-14 13:52
静等中。。。

【统计表】中加代码

zhang19851215

gufengaoyue 发表于 2018-12-14 14:51
【统计表】中加代码

您的联系方式是多少，我加了，没有作用啊

zhang19851215

加了不行啊 没反应

bobfifth

可能我对你的诉求有误解。需要更大的数据，可能会理解。
我以安检项目为例，统计数目和总金额。7种，建8*3数组；
do while 遍历汇总表，把需要的统计表数据保存在数组中；
通过for循环，求出小计的求和值，然后把数据赋值到统计表中。
通过按钮，再写sub清除，完成多次查阅不同日期范围的数据结果。

欢迎私聊，共同进步！
Option Explicit
Sub 清除()
    Sheets("统计表").Range("A2:C9").ClearContents
    Sheets("统计表").Range("A2:C9").ClearFormats
End Sub

Sub 搜索统计()
    Dim ilist, i, j As Integer
    Dim arr(8, 3), idate, mindate, maxdate
    Dim sht As Worksheet

    Set sht = Sheets("汇总表")
    arr(1, 1) = "大型客车/校车"
    arr(2, 1) = "路试/危险运输车"
    arr(3, 1) = "其他小型汽车"
    arr(4, 1) = "其他小型汽车"
    arr(5, 1) = "中重型货车"
    arr(6, 1) = "称重（小型汽车）"
    arr(7, 1) = "微信/支付宝/刷卡"
    arr(8, 1) = "小计"
    ilist = 2
    mindate = Sheets("统计表").[H1].Value
    maxdate = Sheets("统计表").[H2].Value
    i = Sheets("汇总表").Range("B1040000").End(xlUp).Row

    Do While i > 1
        idate = sht.Range("L" & i).Value
        For j = 1 To 7
            If sht.Range("G" & i).Value = arr(j, 1) _
                And idate > mindate _
                And idate < maxdate Then
                arr(j, 2) = arr(j, 2) + 1
                arr(j, 3) = arr(j, 3) + sht.Range("H" & i).Value
            End If
        Next
        i = i - 1
    Loop

    With Sheets("统计表")
        For i = 1 To 8
            For j = 1 To 3
                If arr(i, 2) <> 0 Then
                    .Cells(ilist, j).Value = arr(i, j)
                End If
            Next
            arr(8, 2) = arr(8, 2) + arr(i, 2)
            arr(8, 3) = arr(8, 3) + arr(i, 3)
            If arr(i, 2) <> 0 Then
                ilist = ilist + 1
            End If
        Next
        .Range("A" & ilist - 1).Resize(1, 3).Interior.ColorIndex = 4
    End With

End Sub