码迷,mamicode.com
首页 > 编程语言 > 详细

20170814xlVBA限定日期按客户分类汇总

时间:2017-08-15 10:05:59      阅读:195      评论:0      收藏:0      [点我收藏+]

标签:com   this   src   日期   tin   and   png   value   ota   

原始数据表:

技术分享

汇总格式:

技术分享

 

 

Sub subtotalDic()
    Dim Wb As Workbook
    Dim Sht As Worksheet
    Dim oSht As Worksheet
    Dim mYear As String
    Dim mMon As String
    Dim Arr As Variant
    Dim i As Long, j As Long
    
    Dim Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    Set Wb = Application.ThisWorkbook
    Set Sht = Wb.Worksheets("销售台账")
    Set oSht = Wb.Worksheets("每月汇总")
    
    With oSht
        mYear = .Range("A2").Text
        mMon = .Range("C2").Text
    End With
    
    With Sht
        endrow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row
        If endrow <= 3 Then Exit Sub
        Set Rng = .Range("A4:N" & endrow)
        Arr = Rng.Value
        For i = LBound(Arr) To UBound(Arr)
            If CStr(Arr(i, 1)) = mYear And CStr(Arr(i, 2)) = mMon Then
                Key = CStr(Arr(i, 4))
                Dic(Key) = Dic(Key) + Arr(i, 8)
            End If
        Next i
    End With
    
    With oSht
        endrow = .Cells(.Cells.Rows.Count, 2).End(xlUp).Row
        For i = 5 To endrow
            Key = .Cells(i, 2).Text
            .Cells(i, 3).Value = Dic(Key)
        Next i
        
        endrow = .Cells(.Cells.Rows.Count, 5).End(xlUp).Row
        For i = 5 To endrow
            Key = .Cells(i, 5).Text
            .Cells(i, 6).Value = Dic(Key)
        Next i
    End With
    
    
    Set Wb = Nothing
    Set Sht = Nothing
    Set oSht = Nothing
    Set Rng = Nothing
    Set Dic = Nothing
    
End Sub

  

20170814xlVBA限定日期按客户分类汇总

标签:com   this   src   日期   tin   and   png   value   ota   

原文地址:http://www.cnblogs.com/nextseven/p/7363122.html

(0)
(0)
   
举报
评论 一句话评论(0
登录后才能评论!
© 2014 mamicode.com 版权所有  联系我们:gaon5@hotmail.com
迷上了代码!