按要求修改VBA过程的J列公式代码

lsc900707

13782671637 发表于 2018-5-21 12:30
那就谢谢老师了！恳请老师帮忙解决！

看的云里雾里的，不知道是不是这个意思：

1. Sub test()
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     r = [c2]
   
5.     arr = Range("e5:j" & r)
   
6.     ReDim brr(1 To UBound(arr), 1 To 6)
   
7.     For Each sht In Sheets
   
8.         If sht.Name <> ActiveSheet.Name Then
   
9.             With sht
   
10.                  xm = .[i1]: n = .[c2]
    
11.                  m = 0
    
12.                  For i = 1 To UBound(arr)
    
13.                      If arr(i, 6) = xm Then
    
14.                          m = m + 1
    
15.                          For j = 1 To 5
    
16.                              brr(m, j) = arr(i, j)
    
17.                          Next
    
18.                      End If
    
19.                  Next
    
20.                  If m <= n Then
    
21.                      For i = 2 To UBound(brr)
    
22.                          If Len(brr(i, 1)) = 0 Then
    
23.                              brr(i, 6) = ""
    
24.                          Else
    
25.                              brr(i, 6) = brr(i, 1) - brr(i - 1, 1)
    
26.                          End If
    
27.                     Next
    
28.                     .Range("e5:i" & .Rows.Count).ClearContents
    
29.                     .Range("e5").Resize(UBound(brr), UBound(brr, 2)) = brr
    
30.                 Else
    
31.                     For i = 2 To n
    
32.                          If Len(brr(i, 1)) = 0 Then
    
33.                              brr(i, 6) = ""
    
34.                          Else
    
35.                              brr(i, 6) = brr(i, 1) - brr(i - 1, 1)
    
36.                          End If
    
37.                     Next
    
38.                     .Range("e5:i" & .Rows.Count).ClearContents
    
39.                     .Range("e5").Resize(n, UBound(brr, 2)) = brr
    
40.                 End If
    
41.             End With
    
42.         End If
    
43.     Next
    
44.     Application.ScreenUpdating = True
    
45.     MsgBox "数据计算完毕！"
    
46. End Sub

复制代码

lsc900707

13782671637 发表于 2018-5-21 12:13
版主老师：经测试，16楼附件里的代码基本上实现了我所需要的条件提取和计算功能，很好用！还有以下几个问 ...

第三个问题：不需做任何修改，只要表名不是“总表”即可。

13782671637

lsc900707 发表于 2018-5-21 13:28
看的云里雾里的，不知道是不是这个意思：

老师：复制粘贴代码后无法运行。是什么原因？
提示“缺少 =”

13782671637

lsc900707 发表于 2018-5-21 13:33
第三个问题：不需做任何修改，只要表名不是“总表”即可。

麻烦您做成附件上传好吗？

lsc900707

13782671637 发表于 2018-5-21 13:38
麻烦您做成附件上传好吗？

请自行测试结果是否符合要求：

13782671637

lsc900707 发表于 2018-5-21 13:47
请自行测试结果是否符合要求：

老师：J列的计算结果显示请按照截图中批注要求的办。

还有，代码在工作簿增加新工作表后点击“更新分表”就会出现错误。所以，必须在代码中明确需要提取数据的工作表名称。

13782671637

lsc900707 发表于 2018-5-21 13:47
请自行测试结果是否符合要求：

还有：我在后三个工作表的指定最大行号下面都加了一个统计表。如截图所示：



但点击《总表》的【更新分表】按钮后，统计表全部变成了空白。


说明代码的计算范围没有限制在C2指定的区域里。怎样解决？

13782671637

恳请老师们帮忙解决26、27楼里提到的问题。

13782671637

13782671637 发表于 2018-5-21 14:10
老师：J列的计算结果显示请按照截图中批注要求的办。

还有，代码在工作簿增加新工作表后点击“更新分表”就会出现错误。所以，必须在代码中明确需要提取数据的工作表名称。

13782671637

恳请老师们帮忙解决26、27楼里提到的问题。