修改保存位置

lufabao7788

解决同一期活动的收入、支出、提成支出保存到同一行。

lufabao7788

grf1973老师在吗？不好意思打扰了，我又增加了一项内容，劳烦您给看看。

lufabao7788

沉底了，老师们看不到了，再提提。

lufabao7788

各位老师，请指教。

grf1973

提成也可以集成到循环里的。

1. Sub grf()
   
2.     Dim sht As Worksheet
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Dim brr(1 To 100, 1 To 20)
   
5.     For Each sht In Worksheets
   
6.         nm = sht.Name
   
7.         If nm Like "第*" Then
   
8.             x = Split(nm, "次")(0) & "次活动"
   
9.             If Not d.Exists(x) Then
   
10.                 n = n + 1
    
11.                 d(x) = n
    
12.                 brr(n, 1) = n
    
13.                 brr(n, 2) = x
    
14.             End If
    
15.             p = d(x)
    
16.             If InStr(nm, "缴费") Then   '缴费表
    
17.                 brr(p, 3) = sht.[a2]
    
18.                 brr(p, 4) = sht.[k5]
    
19.                 brr(p, 5) = sht.[g5]
    
20.                 brr(p, 7) = sht.[p5]
    
21.             Else            '支出表
    
22.                 brr(p, 8) = sht.[d5]
    
23.                 brr(p, 10) = sht.[d5]
    
24.             End If
    
25.         ElseIf nm = "提成库" Then   '★★★增加了提成部分，
    
26.             crr = sht.Range("a5:i" & sht.[a65536].End(3).Row)
    
27.             For i = 1 To UBound(crr)
    
28.                 x = Split(crr(i, 1), "次")(0) & "次活动"
    
29.                 If Not d.Exists(x) Then
    
30.                     n = n + 1
    
31.                     d(x) = n
    
32.                     brr(n, 1) = n
    
33.                     brr(n, 2) = x
    
34.                 End If
    
35.                 p = d(x)
    
36.                 brr(p, 11) = crr(i, 8)
    
37.                 brr(p, 12) = brr(p, 12) + crr(i, 9)
    
38.             Next
    
39.         End If
    
40.     Next
    
41.     If n > 0 Then [a9].Resize(n, 12) = brr
    
42. End Sub
    

复制代码

lufabao7788

grf1973 发表于 2018-10-19 10:30
提成也可以集成到循环里的。

太好了grf1973老师，经过您几次帮忙，我的表格已基本完成，十分感谢！