[已解决]以字段名“工序”不为空为条件，汇总得出201601带颜色的工作表

野蛮女

想从数据源提出符合条件的数据，以字段名“工序”不为空为条件

最佳答案

月排行榜 / 总排行榜

雪舞子

2016-2-20 16:35

全部汇总到总表里了，
测试一下结果。

1. Sub test()
   
2.     Dim sh, arr, ar, brr(10000, 6), i&, j&, n&
   
3.     ar = Array("产品型号", "图号", "零件名称", "工序", "单价元", "合计元", "单位")
   
4.     For i = 0 To UBound(ar)
   
5.         brr(0, i) = ar(i)
   
6.     Next
   
7.     ar = Array(2, 3, 4, 6, 11, 12)
   
8.     For Each sh In Sheets
   
9.         If sh.Name <> "总表" Then
   
10.             With sh
    
11.                 arr = .Range("a1:l" & .[f65536].End(3).Row)
    
12.             End With
    
13.             For i = 1 To UBound(arr)
    
14.                 If Len(arr(i, 6)) And Trim(arr(i, 6)) <> "工序" Then
    
15.                     n = n + 1
    
16.                     For j = 0 To UBound(ar)
    
17.                         brr(n, j) = arr(i, ar(j))
    
18.                     Next
    
19.                     brr(n, 6) = sh.Name
    
20.                 End If
    
21.             Next
    
22.         End If
    
23.     Next
    
24.     With Sheets("总表")
    
25.         .Cells.ClearContents
    
26.         .[a1].Resize(n, 7) = brr
    
27.     End With
    
28.     MsgBox "汇总结束！"
    
29. End Sub

复制代码

数据源.rar (104.3 KB, 下载次数: 6)

2016-2-20 16:35 上传

点击文件名下载附件

跳转到最佳答案楼层

雪舞子

全部汇总到总表里了，
测试一下结果。

1. Sub test()
   
2.     Dim sh, arr, ar, brr(10000, 6), i&, j&, n&
   
3.     ar = Array("产品型号", "图号", "零件名称", "工序", "单价元", "合计元", "单位")
   
4.     For i = 0 To UBound(ar)
   
5.         brr(0, i) = ar(i)
   
6.     Next
   
7.     ar = Array(2, 3, 4, 6, 11, 12)
   
8.     For Each sh In Sheets
   
9.         If sh.Name <> "总表" Then
   
10.             With sh
    
11.                 arr = .Range("a1:l" & .[f65536].End(3).Row)
    
12.             End With
    
13.             For i = 1 To UBound(arr)
    
14.                 If Len(arr(i, 6)) And Trim(arr(i, 6)) <> "工序" Then
    
15.                     n = n + 1
    
16.                     For j = 0 To UBound(ar)
    
17.                         brr(n, j) = arr(i, ar(j))
    
18.                     Next
    
19.                     brr(n, 6) = sh.Name
    
20.                 End If
    
21.             Next
    
22.         End If
    
23.     Next
    
24.     With Sheets("总表")
    
25.         .Cells.ClearContents
    
26.         .[a1].Resize(n, 7) = brr
    
27.     End With
    
28.     MsgBox "汇总结束！"
    
29. End Sub

复制代码

数据源.rar (104.3 KB, 下载次数: 6)

2016-2-20 16:35 上传

点击文件名下载附件

雪舞子

后面有几张表“工序”列提前了一列，
造成数据读取不准确，
调整表格还是调整代码？