[已解决]加多一列和

张雄友

加多一列和，增加  D  列这列的和。

最佳答案

月排行榜 / 总排行榜

grf1973

2015-5-11 09:31

。。。。。。。。。。。

跳转到最佳答案楼层

grf1973

1. Sub grf()
   
2.     '第2列工号，第3列姓名，第8列制单号，第11列工序名称，第14列产量！
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     arr = Sheets("交飞明细").Range("A1").CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To 100)
   
7.     For i = 2 To UBound(arr)
   
8.         x = arr(i, 2): cl = arr(i, 14)
   
9.         zf = arr(i, 11) & " " & cl       '工序名称+产量
   
10.         If Not d.Exists(x) Then
    
11.             s = s + 1
    
12.            d(x) = s
    
13.            brr(s, 1) = arr(i, 2)
    
14.            brr(s, 2) = arr(i, 3)
    
15.            brr(s, 3) = arr(i, 5)
    
16.            brr(s, 4) = cl      '产量
    
17.            brr(s, 5) = zf      '工号+工序名称+产量
    
18.         Else
    
19.            n = d(x)
    
20.            brr(n, 4) = brr(n, 4) + cl
    
21.            brr(n, 5) = brr(n, 5) & "," & zf        '先把所有   工号+工序名称+产量 全部放入第4列
    
22.         End If
    
23.     Next
    
24.     d.RemoveAll
    
25.    
    
26.     For i = 1 To s
    
27.         xrr = Split(brr(i, 5), ",")    '对第4列进行分析
    
28.         For j = 0 To UBound(xrr)
    
29.             y = xrr(j)
    
30.             yrr = Split(y, " ")
    
31.             gx = yrr(0)          '工序名称
    
32.             d(gx) = d(gx) + Val(yrr(1))
    
33.         Next
    
34.         For Each gx In d.Keys
    
35.             k = k + 1: If 4 + k > maxk Then maxk = 4 + k   '最大列
    
36.             brr(i, 4 + k) = gx & " " & d(gx) & " 件"
    
37.         Next
    
38.         d.RemoveAll
    
39.         k = 0
    
40.     Next
    
41.     Sheet3.[a2].Resize(s, maxk) = brr
    
42. End Sub

复制代码

grf1973

简化代码：

1. Sub grf()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     Set d2 = CreateObject("scripting.dictionary")
   
5.     arr = Sheets("交飞明细").Range("A1").CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To 100)
   
7.     For i = 2 To UBound(arr)
   
8.         x = arr(i, 2): gx = arr(i, 11): cl = arr(i, 14)
   
9.         y = arr(i, 2) & gx       '工号+工序
   
10.         If Not d.Exists(x) Then s = s + 1: d(x) = s
    
11.         n = d(x)
    
12.         brr(n, 1) = arr(i, 2)
    
13.         brr(n, 2) = arr(i, 3)
    
14.         brr(n, 3) = arr(i, 5)
    
15.         brr(n, 4) = brr(n, 4) + cl
    
16.    
    
17.         d2(y) = d2(y) + cl       '工号+工序的数量
    
18.         If Not d1.Exists(y) Then
    
19.             brr(n, 100) = brr(n, 100) + 1         '利用数组最后一列存放 工号+工序 所在的列
    
20.            d1(y) = 4 + brr(n, 100)
    
21.            If d1(y) > maxk Then maxk = d1(y)     '最大列
    
22.         End If
    
23.         brr(n, d1(y)) = gx & " " & d2(y) & " 件"
    
24.     Next
    
25.     Sheet3.[a2].Resize(s, maxk) = brr
    
26. End Sub
    

复制代码

张雄友

grf1973 发表于 2015-5-8 14:30
简化代码：

没有那么简单的：如下面这条记录都没有实现排序

38147

孔a云

A1

1883

折衫返执 823 件

折衫 1060 件

是要像下面这样的：按产量从大到小排序，1楼附件是冒泡法排序。1060>823,所以排在前面。

38147

孔a云

A1

1883

折衫 1060 件

折衫返执 823 件

http://www.excelpx.com/thread-342859-1-1.html

grf1973

。。。。。。。。。。。

张雄友

grf1973 发表于 2015-5-11 09:31
。。。。。。。。。。。

怎么不能实现《效果》？从第E列起，有制单号的，即：制单号+工序名称+数量。如果有二个以上制单号，要用括号括起来。

grf1973

http://www.excelpx.com/thread-342802-1-1.html不是有结果了？