[已解决]同工作薄中，当其它表不满足某条件其数据自动生成在另一表中

文轩馨婷

要求：（看附件）
当其它各表（如"北海装配车间"、"北海上色车间"、"北海搪胶车间"、"北海注塑车间"等——后续还会有增加表）“完成工时达标%”小于75%——其对应产品编号对产品编号，名称对名称，工序对工序，SOP工时对SOP标准工时，实际工时对车间实际生产工时，原因分析引用备注内容（没有备注内容都显示“慢,需加强管理”）；生产部门为所在表的名称，主要责任人（装配车间为“张三”；上色车间为“李四”；搪胶车间为“周五”；注塑车间为“郑六”）自动生成在“效率低的分析表”中
最终达到效果如上表（会随着各表达标率小于75%数据的增加而增加减少而减少）


注意：各表中每天的生产数据不一样(例如：5月2日北海上色车间数据有89条，在5月3日其数据可能达到上百条，如果是7.8.9月份几百条数据也会存在）

劳烦各位帮帮忙！！

谢谢！

最佳答案

月排行榜 / 总排行榜

dsmch

2014-5-6 15:15

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr(1 To 60000, 1 To 9), i%, j&, s&, zf$
   
3. For i = 2 To Sheets.Count
   
4.     zf = Sheets(i).Name
   
5.     arr = Sheets(i).Range("a1").CurrentRegion
   
6.     For j = 3 To UBound(arr)
   
7.         If arr(j, 9) < 0.75 Then
   
8.             s = s + 1
   
9.             brr(s, 1) = zf
   
10.             brr(s, 2) = arr(j, 1)
    
11.             brr(s, 3) = arr(j, 2)
    
12.             brr(s, 4) = arr(j, 3)
    
13.             brr(s, 5) = arr(j, 8)
    
14.             brr(s, 6) = arr(j, 6)
    
15.             brr(s, 7) = arr(j, 10)
    
16.             brr(s, 8) = arr(j, 9)
    
17.             'brr(s, 9) = 负责人
    
18.         End If
    
19.     Next
    
20. Next
    
21. Sheet1.Activate
    
22. Range("a3").Resize(s, UBound(brr, 2)) = brr
    
23. End Sub
    

复制代码

dsmch

………………

文轩馨婷

dsmch 发表于 2014-5-6 14:24
………………

十分感谢！

但还有这两点没达到：1.原因分析——没有备注内容都显示“慢,需加强管理”；2.主要责任人（装配车间为“张三”；上色车间为“李四”；搪胶车间为“周五”；注塑车间为“郑六”）————麻烦在帮忙改进改进！（用这个附件）

另：我还想在增加一个要求：引用各表数据的最后一行不引用（即合计那一行）


老师麻烦在看看！

谢谢！（我稍微改了一下如附件）

dsmch

按楼主要求完善一下代码

1. Sub Macro1()
   
2. Dim arr, brr(1 To 60000, 1 To 9), i%, j&, s&, zf$
   
3. w = Array("张三", "李四", "王五", "郑六")
   
4. For i = 2 To Sheets.Count
   
5.     zf = Sheets(i).Name
   
6.     arr = Sheets(i).Range("a1").CurrentRegion
   
7.     For j = 3 To UBound(arr)-1
   
8.         If arr(j, 9) < 0.75 Then
   
9.             s = s + 1
   
10.             brr(s, 1) = zf
    
11.             brr(s, 2) = arr(j, 1)
    
12.             brr(s, 3) = arr(j, 2)
    
13.             brr(s, 4) = arr(j, 3)
    
14.             brr(s, 5) = arr(j, 8)
    
15.             brr(s, 6) = arr(j, 6)
    
16.             brr(s, 7) = IIf(arr(j, 10) = "", "慢,需加强管理", arr(j, 10))
    
17.             brr(s, 8) = arr(j, 9)
    
18.             brr(s, 9) = w(i - 2)
    
19.         End If
    
20.     Next
    
21. Next
    
22. Sheet1.Activate
    
23. Range("a3").Resize(s, UBound(brr, 2)) = brr
    
24. End Sub
    

复制代码

dsmch

………………

文轩馨婷

dsmch 发表于 2014-5-6 15:15
………………

老师，最后我还另增了一个要求：引用各表数据的最后一行不引用（即合计那一行）

劳烦在改改！

文轩馨婷

dsmch 发表于 2014-5-6 15:09
按楼主要求完善一下代码

谢谢！

文轩馨婷

dsmch 发表于 2014-5-6 15:15
………………

老师，下午试了一下

还得麻烦您帮忙在改改—— 如果各表“完成工时达标%”有错值（如#DIV/0!），可否弹出一个提示窗口！——下午试了一下，当出现错值时，点击按钮会弹出调试窗口，最后找了很久才发现“完成工时达标%”那列有个错值

文轩馨婷

dsmch 发表于 2014-5-6 15:15
………………

如果是最后才点击自动生成呢？