请老师编写程序，把各单位的奖金在下面空白行小计一下并列在H、I、J列处（见H、I、J列

zhjg5961

chxw68 发表于 2014-4-10 21:49

老师：
我不会做附件，麻烦老师做一个附件传上来。

chxw68

zhjg5961 发表于 2014-4-10 21:51
老师：
我不会做附件，麻烦老师做一个附件传上来。

已经传上来了，你下载测试就行了。

zhjg5961

chxw68 发表于 2014-4-10 21:50
勉强写出来了，请楼主测试。

请老师再加一个“清除”功能，把黄色上合计的数据自动清除。

chxw68

修改好了。

jbjbzjb

fadfdfadfdafad

zhjg5961

jbjbzjb 发表于 2014-4-11 14:20
fadfdfadfdafad

老师：
你编写的程序有问题，具体见附件（有的单位奖金没有合计，有的单位合计不对）。

【问题1b】把各单位的奖金小计一下（15楼的）.rar (19.11 KB, 下载次数: 15)

2014-4-11 20:21 上传

点击文件名下载附件

jbjbzjb

zhjg5961 发表于 2014-4-11 20:22
老师：
你编写的程序有问题，具体见附件（有的单位奖金没有合计，有的单位合计不对）。

你现在上的附件跟早先附件表格框架根本不一样！！！！

评：不规范的表格，早先上的附件就要列出各种可能情况！

另：似此等表格，即便再改写了代码，事后，你会再拿一个附件来套而一样通不过。所以，改写代码无意义。

excel002009

D377单元格没公式，我帮你补上了，按钮只限点一次，点按钮前后都看下表里内容，确认点按钮后的内容是不是你想要的结果。
【黄色部分说明】把各单位的奖金小计一下.rar (26.5 KB, 下载次数: 22)

2014-4-12 12:17 上传

点击文件名下载附件

excel002009

1. Sub jsm()
   
2. Dim z&, crr, arr, i&, brr, rng As Range, t&
   
3. Application.ScreenUpdating = False
   
4. crr = ActiveSheet.UsedRange
   
5. z = UBound(crr)
   
6. arr = Range("A1").CurrentRegion
   
7. i = UBound(arr)
   
8. Do While i <= z
   
9.    i = i + 1
   
10.    t = i
    
11.    Do While Range("F" & t) = ""
    
12.       If t > z Then Exit Do
    
13.       If Range("F" & t).Rows.Count > 1 Or Range("F" & t).Columns.Count > 1 Then GoTo 100
    
14.       Range("F" & t).Value = "填"
    
15.       t = t + 1
    
16. 100:
    
17.    Loop
    
18.    If t <= z Then
    
19.     If IsNumeric(Range("F" & t)) Then
    
20.       For Each rng In Range(Range("A" & t + 1), Range("G" & t + 1))
    
21.           If rng.Value <> "" Then
    
22.              s = s & rng.Value
    
23.              Exit For
    
24.           End If
    
25.       Next
    
26.       If s <> "" Then
    
27.          i = t + 2
    
28.       Else
    
29.          i = t + 1
    
30.       End If
    
31.     End If
    
32.    End If
    
33.    If IsNumeric(Range("D" & i - 1)) And Range("D" & i - 1) <> "" Then
    
34.       brr = Range("D" & i - 1).Resize(1, 3)
    
35.       Range("D" & i).Resize(1, 3).Value = brr
    
36.       Range("D" & i).Resize(1, 3).Interior.Color = vbYellow
    
37.    End If
    
38.    If IsNumeric(Range("D" & i - 2)) And Range("D" & i - 2) <> "" Then
    
39.          brr = Range("D" & i - 2).Resize(1, 3)
    
40.          Range("D" & i).Resize(1, 3).Value = brr
    
41.          Range("D" & i).Resize(1, 3).Interior.Color = vbYellow
    
42.    End If
    
43.    If i > z Then Exit Do
    
44.    Do While Range("A" & i).Value = ""
    
45.       Range("A" & i).Value = "填充"
    
46.       i = i + 1
    
47.    Loop
    
48.    arr = Range("A1").CurrentRegion
    
49.    i = UBound(arr)
    
50. Loop
    
51. For Each rng In ActiveSheet.UsedRange
    
52.   If rng.MergeArea.Rows.Count = 1 And rng.MergeArea.Columns.Count = 1 Then
    
53.     If rng.Value = "填充" Or rng.Value = "填" Then
    
54.        rng.Value = ""
    
55.     End If
    
56.   End If
    
57. Next
    
58. Application.ScreenUpdating = True
    
59. End Sub
    
60. 
    
61. 
    
62. 
    
63. 
    

复制代码

zhjg5961

jbjbzjb 发表于 2014-4-11 20:44
你现在上的附件跟早先附件表格框架根本不一样！！！！

评：不规范的表格，早先上的附件就要列出各种可 ...

老师你好：
    我工作中的表格都是这样不规范，我想“投机取点巧”，如果我把表格都整理的这么规范，再使用程序就没有取巧的价值了。
    谢谢老师帮忙编写公式，不想再编写就算了。
    再次感谢老师！