[已解决]提取数据优化代码

张雄友

我知道，但是这样就会从另一角度得知某个车间的情况，原素，生产力等等......

dsmch

1. Sub Macro2()
   
2. Dim rng As Range, arr, brr(1 To 20000, 1 To 11), i&, n&, s%
   
3. Application.ScreenUpdating = False
   
4. Sheets("明细").Activate
   
5. Set rng = [a1:o615]
   
6. arr = rng
   
7. w = Array("3A", "3B", "3C", "2G", "2H", "2J", "A1", "A2", "B1")
   
8. Sheets("明细").FilterMode = False
   
9. rng.Sort Key1:=Range("j2"), Order1:=xlDescending, Header:=xlGuess
   
10. For i = 0 To UBound(w)
    
11.     Range("a1").AutoFilter Field:=2, Criteria1:=w(i)
    
12.     [l1].AutoFilter Field:=12, Criteria1:=">=" & 8
    
13.     GoSub 100
    
14. Next
    
15. ActiveSheet.ShowAllData
    
16. Sheet1.Range("a2").Resize(n, UBound(brr, 2)) = brr
    
17. Erase brr
    
18. n = 0
    
19. rng.Sort Key1:=Range("J2"), Order1:=xlAscending, Header:=xlGuess
    
20. For i = 0 To UBound(w)
    
21.     Range("a1").AutoFilter Field:=2, Criteria1:=w(i)
    
22.     [l1].AutoFilter Field:=12, Criteria1:=">=" & 8
    
23.    GoSub 100
    
24. Next
    
25. ActiveSheet.ShowAllData
    
26. [a1].AutoFilter
    
27. Sheet4.Range("a2").Resize(n, UBound(brr, 2)) = brr
    
28. rng = arr
    
29. GoTo line1
    
30. 100:
    
31. s = 0
    
32. For Each m In [b2:b615].SpecialCells(xlCellTypeVisible)
    
33.     s = s + 1
    
34.     If s < 11 Then
    
35.         h = m.Row
    
36.         n = n + 1
    
37.         brr(n, 1) = Cells(h, 2)
    
38.         brr(n, 2) = Cells(h, 4)
    
39.         brr(n, 3) = Cells(h, 5)
    
40.         brr(n, 4) = Cells(h, "h")
    
41.         brr(n, 5) = Cells(h, "i")
    
42.         brr(n, 9) = Cells(h, "j")
    
43.         brr(n, 10) = Cells(h, "l")
    
44.         brr(n, 11) = Cells(h, "m")
    
45.     Else
    
46.         Exit For
    
47.     End If
    
48. Next
    
49. y = IIf(s > 10, 1, 11 - s)
    
50. y2 = IIf(s > 10, 10, s)
    
51. n = n + y: brr(n, 1) = w(i) & "  " & y2 & "人 "
    
52. Return
    
53. line1:
    
54. Application.ScreenUpdating = True
    
55. End Sub
    

复制代码