[已解决]谁能帮我用写以下程序啊？大哥求你了

zjdh

连次数天数也可以一起解决：

1. Sub test()
   
2.     Dim I%, J%, K%, N%, C%, T%
   
3.     Range("O3:Q65536").ClearContents
   
4.     For I = 3 To Range("M65536").End(3).Row
   
5.         Set D = CreateObject("scripting.dictionary")
   
6.         C = 0: T = 0
   
7.         If Cells(I, "Q").MergeCells Then N = Cells(I, "Q").MergeArea.Count - 1 Else N = 0
   
8.         For J = 0 To N
   
9.             For K = 4 To 12
   
10.                 If Trim(Cells(I + J, K)) <> "" Then
    
11.                 D(Cells(2, K).Value) = ""
    
12.                 C = C + 1
    
13.                 T = T + Cells(I + J, K)
    
14.                 End If
    
15.             Next
    
16.         Next
    
17.         Cells(I, "O") = C
    
18.         Cells(I, "P") = T
    
19.         Cells(I, "Q") = Join(D.KEYS, "&")
    
20.         I = I + N
    
21.     Next
    
22. End Sub

复制代码

jeffljh

zjdh 发表于 2013-7-6 18:38

谢谢了，你的代码太管用了，高手！