[已解决]代码运行后取数出错

hwc2ycy · 发表于 2012-9-3 11:38

caishensi 发表于 2012-9-3 11:17
发生额没错，日、月两列取数出错，比如输入“1801”，发生额应该是7月份的

下午再帮你看，

，有点事情得忙了。

caishensi · 发表于 2012-9-3 11:46

hwc2ycy 发表于 2012-9-3 11:38
下午再帮你看，，有点事情得忙了。

谢谢你，我自已改了一下，只有“1001”运行正确，其它的就会出错，纠结之中。
Sub 总帐()
Dim SD As Date
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Sheets("总分类帐").Select
Range("a7:h65536").ClearContents
科目代码 = Range("c2")
SD = Range("e3")
sarr = Sheets("凭证记录").UsedRange
   For I = 2 To UBound(sarr)
   If sarr(I, 6) < SD Then
      d3(sarr(I, 34)) = d3(sarr(I, 34)) + sarr(I, 19) - sarr(I, 20)
   End If
Next I
Range("h6") = d3(科目代码)
Range("g6") = IIf(Range("h6") > 0, "借", IIf(Range("h6") < 0, "贷", "平"))

For r = 2 To UBound(sarr)
   If sarr(r, 6) >= SD Then
         y = Format(sarr(r, 6), "yyyy-mm-dd")
      d2(Month(y)) = Application.Max(sarr(r, 4), d2(Month(y)))
      If sarr(r, 34) = 科目代码 And sarr(r, 6) >= SD Then
            d(y) = d(y) + sarr(r, 19)
            d1(y) = d1(y) + sarr(r, 20)
      End If
End If
Next r
If d.Count = 0 Then MsgBox "No data": Exit Sub
[a7].Resize(d.Count, 1) = Application.Transpose(d.keys)
[b7].Resize(d.Count, 1) = Application.Transpose(d.keys)
[c7].Resize(d.Count, 1) = Application.Transpose(d2.items)
[e7].Resize(d.Count, 1) = Application.Transpose(d.items)
[f7].Resize(d.Count, 1) = Application.Transpose(d1.items)
For I = 1 To d.Count
      Cells(I + 6, 3) = "1 -  " & Cells(I + 6, 3)
      Cells(I + 6, 4) = "本月发生额"
      Cells(I + 6, 8) = Round(Cells(I + 5, 8) + Cells(I + 6, 5) - Cells(I + 6, 6), 2)
      s1 = s1 + Cells(I + 6, 5)
      s2 = s2 + Cells(I + 6, 6)
      Cells(I + 6, 7) = IIf(Cells(I + 6, 8) > 0, "借", IIf(Cells(I + 6, 8) < 0, "贷", "平"))
Next
Cells(7 + d.Count, 4) = "本年合计"
Cells(7 + d.Count, 5) = s1
Cells(7 + d.Count, 6) = s2
Cells(7 + d.Count, 8) = Cells(6 + d.Count, 8)
Cells(7 + d.Count, 7) = Cells(6 + d.Count, 7)
Application.ScreenUpdating = True
End Sub

20120902.rar (50.18 KB, 下载次数: 10)

hwc2ycy · 发表于 2012-9-3 13:05

本帖最后由 hwc2ycy 于 2012-9-3 13:17 编辑

20120902修正.rar (52.01 KB, 下载次数: 6)

caishensi · 发表于 2012-9-3 14:20

hwc2ycy 发表于 2012-9-3 13:05
改好了，你再试试。
改的那个有个问题，你看设个断点，就会发现，D,D1,D2三个的长度不一样。

你好，凭证编码生成还是出错，另外当记录只有一条是不会汇总。

hwc2ycy · 发表于 2012-9-3 14:28

caishensi 发表于 2012-9-3 14:20
你好，凭证编码生成还是出错，另外当记录只有一条是不会汇总。

哦，我看错了，当时是数据列的问题。再研究下。

hwc2ycy · 发表于 2012-9-3 14:41

caishensi 发表于 2012-9-3 14:20
你好，凭证编码生成还是出错，另外当记录只有一条是不会汇总。

对了，有个问题，你的E3是跨工作簿引用的。
我这边刚直接改成了数值。

还有个问题，你第一个表里的33，可他的科目代码，总帐编码并不等于1101

所以，你在第一次查的时候，只是考虑时间是否相等，至于编码就不在考虑范围之内了。

我改后的程序，会从时间和编码来考虑，只要相等的才会计入统计范围。
我把取C列数据的代码稍微改下就可以了。

caishensi · 发表于 2012-9-3 14:42

hwc2ycy 发表于 2012-9-3 14:28
哦，我看错了，当时是数据列的问题。再研究下。

sarr(r, 17) = 科目代码要改为sarr(r, 34) = 科目代码，D、D1、D2长度确实出现不一样，是出错的原因，“凭证记录表”中的日期列同一月份如果是相同的话不会出错，如出同一月份有不同的日期，就会出现长度不一样，要如何解决这个问题？

caishensi · 发表于 2012-9-3 14:50

hwc2ycy 发表于 2012-9-3 14:41
对了，有个问题，你的E3是跨工作簿引用的。
我这边刚直接改成了数值。

e3那样子改是对的，直接为2012-1-1就行了，sarr(I, 34)列才是一级科目代码

caishensi · 发表于 2012-9-3 14:52

本帖最后由 caishensi 于 2012-9-3 15:12 编辑

hwc2ycy 发表于 2012-9-3 14:41
对了，有个问题，你的E3是跨工作簿引用的。
我这边刚直接改成了数值。

你好，现在关键问题是如何让，D、D1、D2的长度一致，我想半天想不出来。

hwc2ycy · 发表于 2012-9-3 15:20

好像没办法统一了，因为你有的月份有几个日期，这样，写在字典里的话，就会有多个KEY，总数是按月来的，只是一个KEY，这个尺寸就没办法。

我得歇会，太累了，

		自动登录	找回密码
密码			注册