求助各位老师简化VBA，提升运行效率，非常感谢

lsc900707

zhycl 发表于 2018-6-25 19:54
老师，本来我想通过学习一下你的代码，自己改成自己实际需要的，但不知道该如何修改，能帮我改成我实际情 ...

不知道你中间各列有没有数据，举例的时候这些都要说明的，参考代码：

1. Sub gj23w98()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     With Sheets(1)
   
4.          r = .Cells(.Rows.Count, 1).End(3).Row
   
5.         arr = .Range("a6:z" & r)
   
6.     End With
   
7.     ReDim brr(1 To UBound(arr), 1 To 11)
   
8.     For i = 1 To UBound(arr)
   
9.         s = arr(i, 1) & arr(i, 2)
   
10.         If Not d.exists(s) Then
    
11.            m = m + 1
    
12.            d(s) = m
    
13.            brr(m, 1) = arr(i, 1)
    
14.            brr(m, 2) = arr(i, 2)
    
15.            brr(m, 4) = arr(i, 6)
    
16.            brr(m, 6) = arr(i, 8)
    
17.            brr(m, 11) = arr(i, 26)
    
18.         Else
    
19.            brr(d(s), 1) = brr(d(s), 1) & "," & arr(i, 1)
    
20.            brr(d(s), 11) = brr(d(s), 11) + arr(i, 26)
    
21.         End If
    
22.     Next i
    
23.     With Sheets(2)
    
24.        .Range("a:b").NumberFormatLocal = "@"
    
25.        .[a5].Resize(d.Count, 11) = brr
    
26.     End With
    
27.     Set d = Nothing
    
28. End Sub

复制代码

lsc900707

zhycl 发表于 2018-6-25 19:54
老师，本来我想通过学习一下你的代码，自己改成自己实际需要的，但不知道该如何修改，能帮我改成我实际情 ...

结果自行核对：

zhycl

lsc900707 发表于 2018-6-25 20:54
不知道你中间各列有没有数据，举例的时候这些都要说明的，参考代码：

中间各列均有数值

zhycl

lsc900707 发表于 2018-6-25 20:56
结果自行核对：

老师，我的源表中 中间有其它数据，结果测试了不行

lsc900707

zhycl 发表于 2018-6-26 08:48
老师，我的源表中 中间有其它数据，结果测试了不行

自己修改一下呀。

zhycl

lsc900707 发表于 2018-6-26 08:50
自己修改一下呀。

老师我根据自己的表，改了一下红框内的，还是取不到数，表中列均和示例一样，就是表多点。您受累再给看看吧，谢谢了

lsc900707

zhycl 发表于 2018-6-28 16:50
老师我根据自己的表，改了一下红框内的，还是取不到数，表中列均和示例一样，就是表多点。您受累再给看看 ...

你把项目付款明细表完整的信息填写一下，我看一下对应关系再修改！

zhycl

liulang0808 发表于 2018-6-21 20:58
建议楼主上传代码文件
提速，可以考虑关闭屏幕更新
再可以考虑使用数组的

求教老师，指点下面这段代码无法运行的原因，谢谢了
想得到的结果是：
如果G列到Z列的和=0，则
     从AA列到AJ列均为0，
    否则
    AA=G列到Z列的和。
    AB=G列+I列+K列+M列
    AC=H列+J列+L列+N列
    AD=O列
    AE=P列
    AF=Q列+S列+U列+W列
    AG=R列+T列+V列+X列
    AH=Y列
    AI=Z列
    AJ =AA列到AI列之和。


Sub 台账汇总计算()
Dim nRow, arr
Application.ScreenUpdating = False

With Sheets("台账汇总")
  nRow = .Range("a" & .Rows.Count).End(3).Row
  arr = .Range("g5:z" & nRow)
  aarr = .Range("aa5:aj" & nRow)
End With

For i = 1 To UBound(arr)
     
       If WorksheetFunction.Sum(Range("arr(i, 7):arr(i, 26)")) = 0 Then
               
            For k = 27 To 36
            aarr(i, k) = ""
         Next k
      Else
         aarr(i, 27) = WorksheetFunction.Sum(Range("arr(i, 7):arr(i, 26)"))
         aarr(i, 28) = arr(i, 7) + arr(i, 9) + arr(i, 11) + arr(i, 13)
         aarr(i, 29) = arr(i, 8) + arr(i, 10) + arr(i, 12) + arr(i, 14)
         aarr(i, 30) = arr(i, 15)
         aarr(i, 31) = arr(i, 16)
         aarr(i, 32) = arr(i, 17) + arr(i, 19) + arr(i, 21) + arr(i, 23)
         aarr(i, 33) = arr(i, 18) + arr(i, 20) + arr(i, 22) + arr(i, 24)
         aarr(i, 34) = arr(i, 25)
         aarr(i, 35) = arr(i, 26)
         aarr(i, 36) = WorksheetFunction.Sum(Range("arr(i, 27):arr(i, 35)"))
       End If
     
  Next i
  
Sheets("台账汇总").Range("aa5:aj" & nRow) = aarr
Application.ScreenUpdating = True
End Sub

liulang0808

zhycl 发表于 2018-7-16 18:43
求教老师，指点下面这段代码无法运行的原因，谢谢了
想得到的结果是：
如果G列到Z列的和=0，则

代码报错的时候，如果有调试，选择调试看看报错行的参数情况
要不就提供代码及对应附件

zhycl

liulang0808 发表于 2018-7-16 18:56
代码报错的时候，如果有调试，选择调试看看报错行的参数情况
要不就提供代码及对应附件

001.rar (28.61 KB, 下载次数: 3)

2018-7-16 19:09 上传

点击文件名下载附件

老师详见附件，代码在 模块1中，谢谢了