序时账生成会计凭证

bj079

还有附单数及制单、审核、过账不能自动上名称数量

chxw68

bj079 发表于 2016-2-23 10:46
谢谢主，你看看生成后的：第  记4  号-0002/0002凭证，借方金额合计是在科目名称列，贷方金额在借方金额列 ...

对你的问题比较感兴趣，请问每个凭证超过7条记录怎么录入？

bj079

记账时一借多贷、多借一贷及多借多贷不就是有超过7条记录了吗？

chxw68

超过7条怎么处理？

wj2368

bj079 发表于 2016-2-23 10:46
谢谢主，你看看生成后的：第  记4  号-0002/0002凭证，借方金额合计是在科目名称列，贷方金额在借方金额列 ...

。。。。。。。。。。。

bj079

再次请教，不同年月相同凭证号应该分开生成才对的，怎么生成的是在同一张凭证了。(每月生成的凭证号一定是会有相同的，因为每月生成凭证号是从“1”开始)，可否再增加一个“附件单”自动生成，谢谢。

wj2368

bj079 发表于 2016-3-11 12:45
再次请教，不同年月相同凭证号应该分开生成才对的，怎么生成的是在同一张凭证了。(每月生成的凭证号一定是 ...

消息收到。。。。

bj079

太感谢wj2368 了，这才是完美的序时账转会计凭证。真正的高手。

840205910

http://club.excelhome.net/thread-1264872-1-1.html

840205910

Private Sub CommandButton1_Click()
Set d = CreateObject("scripting.dictionary")
arr = Sheet4.UsedRange
r = Sheet2.[a65535].End(3).Row + 1

For i = 5 To UBound(arr)
If arr(i, 1) <> "" Then d(arr(i, 1) & "-" & arr(i, 2) & "-" & arr(i, 3) & "|" & arr(i, 4)) = ""
Next
k = d.Keys


For j = 0 To UBound(k)
ReDim brr(1 To UBound(arr), 1 To 5)
n = 0: jf = 0: df = 0: fd = 0
For i = 5 To UBound(arr)
  If arr(i, 1) <> "" And arr(i, 1) & "-" & arr(i, 2) & "-" & arr(i, 3) & "|" & arr(i, 4) = k(j) Then
   n = n + 1
   jf = jf + arr(i, 8)
   df = df + arr(i, 9)
   fd = fd + arr(i, 10)
   For p = 1 To 5
   brr(n, p) = arr(i, p + 4)
   Next
   
   End If
Next
Y = Application.RoundUp(n / 7, 0)
For q = 1 To Y
ReDim crr(1 To 7, 1 To 5)
Sheet3.Range("a1", "e12").Copy Sheet2.Range("a" & r)
   For w = 1 To 7
   For g = 1 To 5
   If n >= (q - 1) + w Then crr(w, g) = brr((q - 1) * 7 + w, g)
   Next
   Next
  Sheet2.Range("a" & r + 3).Resize(7, 5) = crr
    Sheet2.Range("d" & r + 10) = jf
    Sheet2.Range("e" & r + 10) = df
    Sheet2.Range("b" & r + 10) = "合计：" & DX(df)
    Sheet2.Range("a" & r + 10) = Sheet2.Range("a" & r + 10) & fd
    Sheet2.Range("c" & r + 1) = "日期：" & Split(Split(k(j), "|")(0), "-")(0) & "年" & Split(Split(k(j), "|")(0), "-")(1) & "月" & Split(Split(k(j), "|")(0), "-")(2) & "日"
     Sheet2.Range("e" & r + 1) = "第" & Split(k(j), "|")(1) & "号" & Chr(10) & Format(q, "000") & "/" & Format(Y, "000")
  Erase crr
r = r + 12
Next
Erase brr
Next

End Sub