index row函数出现日期变数字_VBA-003.多表日期汇总求和

1、需求

如下图:一个车号一个工作表且格式一样,现根据各工作表B列日期,按照汇总表的第一行月份2019年1月、2月······统计出各车号的E列金额。麻烦各位老师帮看看怎么写代码

f24a236208bbd15ea25aeb369bb24ee8.png
f3f6c210a116f104e430cf36ae48eb22.png

2、思路分析

1)汇总条件是年+月,所以需要将数据表中的相关数据按照年+月的形式汇总求和

2)将汇总后的结果与汇总条件比对,对坐入号

3)因为要对每个数据表进行日期汇总求和,所以将此功能单独剥离,主过程中调用即可,减少代码调试困难

3、代码

Sub 名称汇总()'   ws_name:工作表名变量参数,字符型'   last_row: 汇总表已使用区域的总行数,数值型'   retruan_arr:接收日期汇总功能的返回值,数组类型'   dt:存储年+月的变量,字符型    Dim ws_name As String, i&, last_row&, return_arr, x&, dt As String        last_row = ActiveSheet.UsedRange.Rows.Count    Range("e2:v" & last_row).ClearContents'   return_arr接收所有数据表的返回值    ReDim return_arr(1 To last_row)        For i = 2 To last_row        ws_name = Cells(i, 3)        '   案例存在多张隐藏表,且隐藏表的结构与其他数据表结构不一,故使用隐藏判断跳过不予汇总        '   如果工作簿中无隐藏表,此判断可删除        '   Visible = -1,表示工作表为可见状态        If Worksheets(ws_name).Visible = -1 Then            '   将所有的数据表(结果是一个二维数组)嵌套写入一个一维数组中,整体形成一个三维数组            return_arr(i - 1) = 日期汇总(ws_name)        End If    Next i    '   汇总表区域的日期与return_arr中的日期维度相比较,如一致则写入对应的单元格中    For i = 1 To last_row    '   汇总表的日期区域,即E1:V1区域,共计18个月        For x = 1 To 18        '   因为表中存在隐藏表,故return_arr一维数组存在空白占位元素,故须进行忽略错误处理            On Error Resume Next            '   循环return_arr每个数据表中的日期维度            For y = 1 To UBound(return_arr(i), 1)                dt = Year(Cells(1, x + 4)) & "-" & Month(Cells(1, x + 4))                If dt = return_arr(i)(y, 1) Then                '   return_arr(i)(y,2):return_arr第i个元素中第y行,第2列的元素                    Cells(i + 1, x + 4) = return_arr(i)(y, 2)                End If            Next y        Next x    Next iEnd SubFunction 日期汇总(ws_name As String)        Dim arr, last_row, x&, brr(), i&, temp As String    last_row = Worksheets(ws_name).UsedRange.Rows.Count    arr = Worksheets(ws_name).Range("b2:e" & last_row)    For x = 1 To last_row        '   将2019/1/24改为年+月格式,即2019-4        temp = Year(arr(x, 1)) & "-" & Month(arr(x, 1))        On Error Resume Next        '   检测工作表的B列日期处理后的temp是否已存在于brr数组中,如存在,则对应元素累加,否则新增相应元素        '   match函数的第二个参数Array必须是一维数组,而brr是二维数组,故须使用Index函数提取单维数据        '   Index(brr,1,0):brr是一个行数为2,列数不固定的数组,第一行值为日期,第二行值为金额累加值,故此句的意思即提取brr的第一行数据,也就是日期行        temp = Application.WorksheetFunction.Match(temp, Application.WorksheetFunction.Index(brr, 1, 0), 0)        '   如果元素存在数组中,则程序不报错,即Err=0,否则程序报错,Err>0        If Err = 0 Then            brr(2, Int(temp)) = brr(2, Int(temp)) + arr(x, 4)        Else            i = i + 1            ReDim Preserve brr(1 To 2, 1 To i)            brr(1, i) = temp            brr(2, i) = arr(x, 4)        End If    Next x    '   个人习惯,将日期行与金额行转置为日期列与金额列,便于主过程使用    日期汇总 = Application.WorksheetFunction.Transpose(brr)    End Function
6d7839ddf3d40b512ed5f76c689fed32.png
  • 0
    点赞
  • 0
    收藏
    觉得还不错? 一键收藏
  • 0
    评论

“相关推荐”对你有帮助么?

  • 非常没帮助
  • 没帮助
  • 一般
  • 有帮助
  • 非常有帮助
提交
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值