[已解决]财务类的凭证汇总求助，查询同一科目多次发生的金额如何查询？

lgpoo

根据<凭证录入>的信息在凭证汇总表中汇总相应科目的内容
比如，总账科目，现金，出现过四次，其中借方出现过2次，就在汇总平衡表中的现金 借 依次显示
借贷 分成两列，依次出现，如何解决？
要先显示凭证号，然后后面对应的显示金额
求助，拜谢！！！
具体看附件

最佳答案

月排行榜 / 总排行榜

adders

2012-1-7 12:04

查询问题求助.rar (10.82 KB, 下载次数: 19)

2012-1-7 12:04 上传

点击文件名下载附件

写得有点拙,应该可以工作(汇总表的A1:P2这个抬头两行请勿更换,否则需要修改代码)

1. 
   
2. Sub tt()
   
3. Application.ScreenUpdating = False
   
4. Dim a As String, b As String, c As String, d As String
   
5. Dim a1j As Long, b1j As Long, c1j As Long, d1j As Long
   
6. Dim a1d As Long, b1d As Long, c1d As Long, d1d As Long
   
7. Dim pzlr As Worksheet
   
8. Dim lr As Long
   
9. Range("A3:P" & Rows.Count).ClearContents
   
10. a = "现金"
    
11. b = "银行存款"
    
12. c = "应收账款"
    
13. d = "应付工资"
    
14. a1j = 3
    
15. b1j = 3
    
16. c1j = 3
    
17. d1j = 3
    
18. a1d = 3
    
19. b1d = 3
    
20. c1d = 3
    
21. d1d = 3
    
22. Set pzlr = Sheets("凭证录入")
    
23. lr = pzlr.Cells(Rows.Count, "E").End(xlUp).Row
    
24. 
    
25. For Each cel In pzlr.Range("E2:E" & lr)
    
26.     Select Case cel.Value
    
27.         Case a
    
28.             If Not IsEmpty(cel.Offset(, 1)) Then
    
29.                 If IsEmpty(cel.Offset(, -3)) Then
    
30.                 Cells(a1j, "A").Value = cel.Offset(-1, -3).Value
    
31.                 Else
    
32.                 Cells(a1j, "A").Value = cel.Offset(, -3).Value
    
33.                 End If
    
34.                 Cells(a1j, "B").Value = cel.Offset(, 1).Value
    
35.                 a1j = a1j + 1
    
36.             Else
    
37.                 If IsEmpty(cel.Offset(, -3)) Then
    
38.                 Cells(a1d, "C").Value = cel.Offset(-1, -3).Value
    
39.                 Else
    
40.                 Cells(a1d, "C").Value = cel.Offset(, -3).Value
    
41.                 End If
    
42.                 Cells(a1d, "D").Value = cel.Offset(, 2).Value
    
43.                 a1d = a1d + 1
    
44.             End If
    
45.         Case b
    
46.             If Not IsEmpty(cel.Offset(, 1)) Then
    
47.                 If IsEmpty(cel.Offset(, -3)) Then
    
48.                 Cells(b1j, "E").Value = cel.Offset(-1, -3).Value
    
49.                 Else
    
50.                 Cells(b1j, "E").Value = cel.Offset(, -3).Value
    
51.                 End If
    
52.                 Cells(b1j, "F").Value = cel.Offset(, 1).Value
    
53.                 b1j = b1j + 1
    
54.             Else
    
55.                 If IsEmpty(cel.Offset(, -3)) Then
    
56.                 Cells(b1d, "G").Value = cel.Offset(-1, -3).Value
    
57.                 Else
    
58.                 Cells(b1d, "G").Value = cel.Offset(, -3).Value
    
59.                 End If
    
60.                 Cells(b1d, "H").Value = cel.Offset(, 2).Value
    
61.                 b1d = b1d + 1
    
62.             End If
    
63.             
    
64.         Case c
    
65.             If Not IsEmpty(cel.Offset(, 1)) Then
    
66.                 If IsEmpty(cel.Offset(, -3)) Then
    
67.                 Cells(c1j, "I").Value = cel.Offset(-1, -3).Value
    
68.                 Else
    
69.                 Cells(c1j, "I").Value = cel.Offset(, -3).Value
    
70.                 End If
    
71.                 Cells(c1j, "J").Value = cel.Offset(, 1).Value
    
72.                 c1j = c1j + 1
    
73.             Else
    
74.                 If IsEmpty(cel.Offset(, -3)) Then
    
75.                 Cells(c1d, "K").Value = cel.Offset(-1, -3).Value
    
76.                 Else
    
77.                 Cells(c1d, "K").Value = cel.Offset(, -3).Value
    
78.                 End If
    
79.                 Cells(c1d, "L").Value = cel.Offset(, 2).Value
    
80.                 c1d = c1d + 1
    
81.             End If
    
82.             
    
83.         Case d
    
84.             If Not IsEmpty(cel.Offset(, 1)) Then
    
85.                 If IsEmpty(cel.Offset(, -3)) Then
    
86.                 Cells(d1j, "M").Value = cel.Offset(-1, -3).Value
    
87.                 Else
    
88.                 Cells(d1j, "M").Value = cel.Offset(, -3).Value
    
89.                 End If
    
90.                 Cells(d1j, "N").Value = cel.Offset(, 1).Value
    
91.                 d1j = d1j + 1
    
92.             Else
    
93.                 If IsEmpty(cel.Offset(, -3)) Then
    
94.                 Cells(d1d, "O").Value = cel.Offset(-1, -3).Value
    
95.                 Else
    
96.                 Cells(d1d, "O").Value = cel.Offset(, -3).Value
    
97.                 End If
    
98.                 Cells(d1d, "P").Value = cel.Offset(, 2).Value
    
99.                 d1d = d1d + 1
    
100.             End If
     
101.     End Select
     
102. Next
     
103. Set pzlr = Nothing
     
104. Application.ScreenUpdating = True
     
105. End Sub
     

复制代码

跳转到最佳答案楼层

adders

查询问题求助.rar (10.82 KB, 下载次数: 19)

2012-1-7 12:04 上传

点击文件名下载附件

写得有点拙,应该可以工作(汇总表的A1:P2这个抬头两行请勿更换,否则需要修改代码)

1. 
   
2. Sub tt()
   
3. Application.ScreenUpdating = False
   
4. Dim a As String, b As String, c As String, d As String
   
5. Dim a1j As Long, b1j As Long, c1j As Long, d1j As Long
   
6. Dim a1d As Long, b1d As Long, c1d As Long, d1d As Long
   
7. Dim pzlr As Worksheet
   
8. Dim lr As Long
   
9. Range("A3:P" & Rows.Count).ClearContents
   
10. a = "现金"
    
11. b = "银行存款"
    
12. c = "应收账款"
    
13. d = "应付工资"
    
14. a1j = 3
    
15. b1j = 3
    
16. c1j = 3
    
17. d1j = 3
    
18. a1d = 3
    
19. b1d = 3
    
20. c1d = 3
    
21. d1d = 3
    
22. Set pzlr = Sheets("凭证录入")
    
23. lr = pzlr.Cells(Rows.Count, "E").End(xlUp).Row
    
24. 
    
25. For Each cel In pzlr.Range("E2:E" & lr)
    
26.     Select Case cel.Value
    
27.         Case a
    
28.             If Not IsEmpty(cel.Offset(, 1)) Then
    
29.                 If IsEmpty(cel.Offset(, -3)) Then
    
30.                 Cells(a1j, "A").Value = cel.Offset(-1, -3).Value
    
31.                 Else
    
32.                 Cells(a1j, "A").Value = cel.Offset(, -3).Value
    
33.                 End If
    
34.                 Cells(a1j, "B").Value = cel.Offset(, 1).Value
    
35.                 a1j = a1j + 1
    
36.             Else
    
37.                 If IsEmpty(cel.Offset(, -3)) Then
    
38.                 Cells(a1d, "C").Value = cel.Offset(-1, -3).Value
    
39.                 Else
    
40.                 Cells(a1d, "C").Value = cel.Offset(, -3).Value
    
41.                 End If
    
42.                 Cells(a1d, "D").Value = cel.Offset(, 2).Value
    
43.                 a1d = a1d + 1
    
44.             End If
    
45.         Case b
    
46.             If Not IsEmpty(cel.Offset(, 1)) Then
    
47.                 If IsEmpty(cel.Offset(, -3)) Then
    
48.                 Cells(b1j, "E").Value = cel.Offset(-1, -3).Value
    
49.                 Else
    
50.                 Cells(b1j, "E").Value = cel.Offset(, -3).Value
    
51.                 End If
    
52.                 Cells(b1j, "F").Value = cel.Offset(, 1).Value
    
53.                 b1j = b1j + 1
    
54.             Else
    
55.                 If IsEmpty(cel.Offset(, -3)) Then
    
56.                 Cells(b1d, "G").Value = cel.Offset(-1, -3).Value
    
57.                 Else
    
58.                 Cells(b1d, "G").Value = cel.Offset(, -3).Value
    
59.                 End If
    
60.                 Cells(b1d, "H").Value = cel.Offset(, 2).Value
    
61.                 b1d = b1d + 1
    
62.             End If
    
63.             
    
64.         Case c
    
65.             If Not IsEmpty(cel.Offset(, 1)) Then
    
66.                 If IsEmpty(cel.Offset(, -3)) Then
    
67.                 Cells(c1j, "I").Value = cel.Offset(-1, -3).Value
    
68.                 Else
    
69.                 Cells(c1j, "I").Value = cel.Offset(, -3).Value
    
70.                 End If
    
71.                 Cells(c1j, "J").Value = cel.Offset(, 1).Value
    
72.                 c1j = c1j + 1
    
73.             Else
    
74.                 If IsEmpty(cel.Offset(, -3)) Then
    
75.                 Cells(c1d, "K").Value = cel.Offset(-1, -3).Value
    
76.                 Else
    
77.                 Cells(c1d, "K").Value = cel.Offset(, -3).Value
    
78.                 End If
    
79.                 Cells(c1d, "L").Value = cel.Offset(, 2).Value
    
80.                 c1d = c1d + 1
    
81.             End If
    
82.             
    
83.         Case d
    
84.             If Not IsEmpty(cel.Offset(, 1)) Then
    
85.                 If IsEmpty(cel.Offset(, -3)) Then
    
86.                 Cells(d1j, "M").Value = cel.Offset(-1, -3).Value
    
87.                 Else
    
88.                 Cells(d1j, "M").Value = cel.Offset(, -3).Value
    
89.                 End If
    
90.                 Cells(d1j, "N").Value = cel.Offset(, 1).Value
    
91.                 d1j = d1j + 1
    
92.             Else
    
93.                 If IsEmpty(cel.Offset(, -3)) Then
    
94.                 Cells(d1d, "O").Value = cel.Offset(-1, -3).Value
    
95.                 Else
    
96.                 Cells(d1d, "O").Value = cel.Offset(, -3).Value
    
97.                 End If
    
98.                 Cells(d1d, "P").Value = cel.Offset(, 2).Value
    
99.                 d1d = d1d + 1
    
100.             End If
     
101.     End Select
     
102. Next
     
103. Set pzlr = Nothing
     
104. Application.ScreenUpdating = True
     
105. End Sub
     

复制代码

lgpoo

十分感谢楼上的！！！！！我试一下！！！！！！！！

lgpoo

adders 发表于 2012-1-7 12:04
写得有点拙,应该可以工作(汇总表的A1:P2这个抬头两行请勿更换,否则需要修改代码)

For Each cel In pzlr.Range("E2:E" & lr)
    Select Case cel.Value
        Case a
            If Not IsEmpty(cel.Offset(, 1)) Then
                If IsEmpty(cel.Offset(, -3)) Then
                Cells(a1j, "A").Value = cel.Offset(-1, -3).Value
                Else
                Cells(a1j, "A").Value = cel.Offset(, -3).Value
                End If
                Cells(a1j, "B").Value = cel.Offset(, 1).Value
                a1j = a1j + 1
            Else
                If IsEmpty(cel.Offset(, -3)) Then
                Cells(a1d, "C").Value = cel.Offset(-1, -3).Value
                Else
                Cells(a1d, "C").Value = cel.Offset(, -3).Value
                End If
                Cells(a1d, "D").Value = cel.Offset(, 2).Value
                a1d = a1d + 1
            End If

这个Select Case cel.Value      cel是什么意思？
下面也有用到，  cel 是什么意思呢？

lgpoo

adders 发表于 2012-1-7 12:04
写得有点拙,应该可以工作(汇总表的A1:P2这个抬头两行请勿更换,否则需要修改代码)

高手 能否帮忙解决这个问题一下！
http://www.excelpx.com/thread-218434-1-1.html
就是金额，转换成一格一格的！