Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2376|回复: 1

[已解决]求大侠帮帮我------------呜呜-----------------------

[复制链接]
发表于 2016-1-18 23:02 | 显示全部楼层 |阅读模式
本帖最后由 N7120 于 2016-1-18 23:06 编辑

附件压缩包= 汇总期初2.rar (43.08 KB, 下载次数: 4)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2016-1-20 10:19 | 显示全部楼层    本楼为最佳答案   
  1. Sub 汇总()
  2.     Set d = CreateObject("scripting.dictionary")
  3.     rq1 = [b1]: rq2 = [d1] '起止日期
  4.     Dim brr(1 To 10000, 1 To 5)
  5.     With Sheets("回款付款")
  6.         arr = .Range("a1:ab" & .UsedRange.Rows.Count)
  7.         For j = 3 To 17 Step 14        'j=3 或 17
  8.             For i = 8 To UBound(arr)
  9.                 If Len(arr(i, j)) > 0 Then
  10.                     rq = arr(i, j)
  11.                     x = arr(i, j + 5)
  12.                     If Not d.Exists(x) Then
  13.                         n = n + 1: d(x) = n
  14.                         brr(n, 1) = x
  15.                     End If
  16.                     p = d(x)
  17.                     If rq < rq1 Then     '日期在指定日期之前,期初值
  18.                         k = IIf(j = 3, 2, 3)           'j=3,借方,否则贷方
  19.                         brr(p, k) = brr(p, k) + arr(i, j + 6)
  20.                     ElseIf rq <= rq2 Then        '日期在指定日期之间,本期值
  21.                         k = IIf(j = 3, 4, 5)            'j=3,借方,否则贷方
  22.                         brr(p, k) = brr(p, k) + arr(i, j + 6)
  23.                     End If
  24.                 End If
  25.             Next
  26.         Next
  27.     End With
  28.                
  29.     With Sheets("费用收支")
  30.         arr = .Range("a1:m" & .UsedRange.Rows.Count)
  31.         For i = 8 To UBound(arr)
  32.             If Len(arr(i, 6)) > 0 Then
  33.                 rq = arr(i, 6)
  34.                 x = arr(i, 8)
  35.                 If Not d.Exists(x) Then
  36.                     n = n + 1: d(x) = n
  37.                     brr(n, 1) = x
  38.                 End If
  39.                 p = d(x)
  40.                 If rq < rq1 Then          '日期在指定日期之前,期初值
  41.                     brr(p, 2) = brr(p, 2) + arr(i, 12)
  42.                     brr(p, 3) = brr(p, 3) + arr(i, 13)
  43.                 ElseIf rq <= rq2 Then          '日期在指定日期之间,本期值
  44.                     brr(p, 4) = brr(p, 4) + arr(i, 12)
  45.                     brr(p, 5) = brr(p, 5) + arr(i, 13)
  46.                 End If
  47.             End If
  48.         Next
  49.     End With
  50.     [a8:e10000].ClearContents
  51.     If n > 0 Then [a8].Resize(n, 5) = brr
  52. End Sub
复制代码

汇总期初2.rar

44.4 KB, 下载次数: 9

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 23:35 , Processed in 0.312534 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表