[已解决]怎么样根据记账凭证登记明细账

9910343

怎么样根据记账凭证登记明细账 12211.rar (4.16 KB, 下载次数: 184)

2012-6-25 14:22 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hrpotter

2012-6-25 15:48

1. Sub 明细账()    '按照你现在的表结构编的，如果变动，有可能会出错
   
2.     Dim i As Integer, j As Integer, k As Integer, x As Integer
   
3.     Dim s1 As String, s2 As String
   
4.     Dim x1, x2, x3, x4, x5, x6, x7
   
5.     For i = 2 To Worksheets.Count    '从第二张工作表开始循环
   
6.         s1 = Split(Sheets(i).Name)(0)    '取得工作表名中的总账科目
   
7.         s2 = Split(Sheets(i).Name)(1)    '取得工作表名中的明细科目
   
8.         With Sheets("记账凭证")
   
9.             For j = 5 To .Range("b65536").End(xlUp).Row    '记账凭证的B列第五行开始往下循环
   
10.                 If .Cells(j, 2) = s1 And .Cells(j, 3) = s2 Then    '如果总账科目和明细科目和工作表名中的相等
    
11.                     x = .Cells(j, 6).End(xlUp).Row    '取得凭证号所在的行
    
12.                     x1 = Split(.Cells(x, 2), "  ")(1)    '取得记账月
    
13.                     x2 = Split(.Cells(x, 2), "  ")(2)    '取得记账日
    
14.                     x3 = .Cells(x, 6)    '取得凭证号
    
15.                     x4 = IIf(.Cells(j, 1) = "", .Cells(j, 1).End(xlUp).Value, .Cells(j, 1))    '取得摘要
    
16.                     x5 = .Cells(j, 4)    '取得借方
    
17.                     x6 = .Cells(j, 5)    '取得贷方
    
18.                     If .Cells(j, 4) = "" Then    '取得借或贷
    
19.                         x7 = "贷"
    
20.                     Else
    
21.                         x7 = "借"
    
22.                     End If
    
23.                     With Sheets(i)    '填充明细账
    
24.                         k = .Range("a20").End(xlUp).Row + 1
    
25.                         .Cells(k, 1) = x1
    
26.                         .Cells(k, 2) = x2
    
27.                         .Cells(k, 4) = x3
    
28.                         .Cells(k, 5) = x4
    
29.                         .Cells(k, 6) = x5
    
30.                         .Cells(k, 7) = x6
    
31.                         .Cells(k, 8) = x7
    
32.                     End With
    
33.                 End If
    
34.             Next
    
35.         End With
    
36.     Next
    
37. End Sub

复制代码

跳转到最佳答案楼层

hrpotter

1. Sub 明细账()    '按照你现在的表结构编的，如果变动，有可能会出错
   
2.     Dim i As Integer, j As Integer, k As Integer, x As Integer
   
3.     Dim s1 As String, s2 As String
   
4.     Dim x1, x2, x3, x4, x5, x6, x7
   
5.     For i = 2 To Worksheets.Count    '从第二张工作表开始循环
   
6.         s1 = Split(Sheets(i).Name)(0)    '取得工作表名中的总账科目
   
7.         s2 = Split(Sheets(i).Name)(1)    '取得工作表名中的明细科目
   
8.         With Sheets("记账凭证")
   
9.             For j = 5 To .Range("b65536").End(xlUp).Row    '记账凭证的B列第五行开始往下循环
   
10.                 If .Cells(j, 2) = s1 And .Cells(j, 3) = s2 Then    '如果总账科目和明细科目和工作表名中的相等
    
11.                     x = .Cells(j, 6).End(xlUp).Row    '取得凭证号所在的行
    
12.                     x1 = Split(.Cells(x, 2), "  ")(1)    '取得记账月
    
13.                     x2 = Split(.Cells(x, 2), "  ")(2)    '取得记账日
    
14.                     x3 = .Cells(x, 6)    '取得凭证号
    
15.                     x4 = IIf(.Cells(j, 1) = "", .Cells(j, 1).End(xlUp).Value, .Cells(j, 1))    '取得摘要
    
16.                     x5 = .Cells(j, 4)    '取得借方
    
17.                     x6 = .Cells(j, 5)    '取得贷方
    
18.                     If .Cells(j, 4) = "" Then    '取得借或贷
    
19.                         x7 = "贷"
    
20.                     Else
    
21.                         x7 = "借"
    
22.                     End If
    
23.                     With Sheets(i)    '填充明细账
    
24.                         k = .Range("a20").End(xlUp).Row + 1
    
25.                         .Cells(k, 1) = x1
    
26.                         .Cells(k, 2) = x2
    
27.                         .Cells(k, 4) = x3
    
28.                         .Cells(k, 5) = x4
    
29.                         .Cells(k, 6) = x5
    
30.                         .Cells(k, 7) = x6
    
31.                         .Cells(k, 8) = x7
    
32.                     End With
    
33.                 End If
    
34.             Next
    
35.         End With
    
36.     Next
    
37. End Sub

复制代码

9910343

非常感谢，如果表有变动，我在向你请教

9910343

hrpotter 发表于 2012-6-25 15:48

我把表重新设置了一下，重新发了一贴，有空的话帮我看看，谢谢