[已解决]修改代码

武林长风

差旅费计算6.rar (38.49 KB, 下载次数: 4)

2014-11-30 17:21 上传

点击文件名下载附件 ，点击按钮时出现错误，请大师帮忙：

最佳答案

月排行榜 / 总排行榜

qh8600

2014-11-30 17:58

差旅费计算6.rar (40.14 KB, 下载次数: 17)

2014-11-30 17:57 上传

点击文件名下载附件
改了一下，楼主试试

跳转到最佳答案楼层

qh8600

1. Sub 合计()
   
2.     Dim arr, brr(), d, i&, j%
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("出差记录").Range("a1:v" & Sheets("出差记录").Range("a3").End(xlDown).Row)
   
5.     ReDim brr(1 To 100, 1 To 3)
   
6.     For i = 4 To UBound(arr)
   
7.         x = Split(arr(i, 22), "、")
   
8.         s = UBound(x) + 1
   
9.         Dim xx
   
10.         s2 = (arr(i, 21) - arr(i, 7)) / s
    
11.         s1 = arr(i, 7) + s2
    
12.         For j = 0 To UBound(x)
    
13.             If Not d.exists(x(j)) Then
    
14.                 n = n + 1
    
15.                 d(x(j)) = n
    
16.                 brr(n, 1) = x(j)
    
17.                 brr(n, 2) = IIf(j = 0, s1, s2)
    
18.             Else
    
19.                 n2 = d(x(j))
    
20.                 brr(n2, 2) = brr(n2, 2) + IIf(j = 0, s1, s2)
    
21.             End If
    
22.         Next
    
23.     Next
    
24.     Sheets("个人差旅费合计").Range("a3").Resize(d.Count, 3) = brr
    
25.     MsgBox "汇总完毕！"
    
26. End Sub
    

复制代码

qh8600

差旅费计算6.rar (40.14 KB, 下载次数: 17)

2014-11-30 17:57 上传

点击文件名下载附件
改了一下，楼主试试

〃高调的沉默

qh8600 发表于 2014-11-30 17:57

若数据有一万行时，这个代码怎么改？

kszcs

qh8600 发表于 2014-11-30 17:57

谢谢，学习了