[已解决]自动生成日记账

雄鹰2013

通过记账凭证工作表的数据，自动生成到日记账中蓝色区域

最佳答案

月排行榜 / 总排行榜

dsmch

2015-3-2 10:28

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, zf$$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets("记账凭证").Range("a3").CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To 5)
   
6. zf = "库存现金"
   
7. For i = 4 To UBound(arr)
   
8.     If arr(i, 3) = zf Then d(arr(i, 1)) = ""
   
9. Next
   
10. For i = 4 To UBound(arr)
    
11.     If d.exists(arr(i, 1)) And arr(i, 3) <> zf Then
    
12.         s = s + 1
    
13.         brr(s, 1) = arr(i, 1)
    
14.         brr(s, 2) = arr(i, 2)
    
15.         brr(s, 3) = arr(i, 3)
    
16.         brr(s, 4) = arr(i, 6)
    
17.         brr(s, 5) = arr(i, 5)
    
18.     End If
    
19. Next
    
20. Sheets("日记账").Activate
    
21. [c3:g20000] = ""
    
22. Range("c3").Resize(s, 5) = brr
    
23. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, s&, zf$$
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheets("记账凭证").Range("a3").CurrentRegion
   
5. ReDim brr(1 To UBound(arr), 1 To 5)
   
6. zf = "库存现金"
   
7. For i = 4 To UBound(arr)
   
8.     If arr(i, 3) = zf Then d(arr(i, 1)) = ""
   
9. Next
   
10. For i = 4 To UBound(arr)
    
11.     If d.exists(arr(i, 1)) And arr(i, 3) <> zf Then
    
12.         s = s + 1
    
13.         brr(s, 1) = arr(i, 1)
    
14.         brr(s, 2) = arr(i, 2)
    
15.         brr(s, 3) = arr(i, 3)
    
16.         brr(s, 4) = arr(i, 6)
    
17.         brr(s, 5) = arr(i, 5)
    
18.     End If
    
19. Next
    
20. Sheets("日记账").Activate
    
21. [c3:g20000] = ""
    
22. Range("c3").Resize(s, 5) = brr
    
23. End Sub

复制代码

dsmch

…………

baksy

凭证号 001、003 ... 这些不统计吗？

雄鹰2013

dsmch 发表于 2015-3-2 10:30
…………

19号是两笔业务，它是将同一天的业务放在同一凭证里了。即在那一天既发生了借款又有现金支取

雄鹰2013

baksy 发表于 2015-3-2 10:37
凭证号 001、003 ... 这些不统计吗？

凭证号也是要统计的

1696315990