Hsieh

回復 3# wendy

1. Sub Ex()
   
2. Dim MySh As Worksheets, Sh As Worksheet, MyId As Range, Ar(), Ay(), Ary(), A As Range
   
3. Dim s%, n&
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. For Each Sh In Sheets(Array("1", "2", "3", "4"))
   
6.    With Sh
   
7.    Set MyId = .Cells.Find("品號", lookat:=xlWhole)
   
8.    For Each A In MyId.EntireRow.SpecialCells(xlCellTypeConstants)
   
9.      If A <> "總計" And d.exists(A.Value) = False Then d(A.Value) = d.Count
   
10.    Next
    
11.    End With
    
12. Next
    
13. d("總計") = d.Count
    
14. With Sheets.Add
    
15. On Error Resume Next
    
16. Application.DisplayAlerts = False
    
17. Sheets("用量需求總表").Delete
    
18. .Name = "用量需求總表"
    
19. .[A1].Resize(, d.Count) = d.keys
    
20. ReDim Ay(0 To d.Count)
    
21. For Each Sh In Sheets(Array("1", "2", "3", "4"))
    
22. ReDim Ar(d.Count)
    
23.    With Sh
    
24.    Set MyId = .Cells.Find("品號", lookat:=xlWhole)
    
25.    For Each A In MyId.EntireRow.SpecialCells(xlCellTypeConstants)
    
26.       Ar(s) = d(A.Value)
    
27.       s = s + 1
    
28.    Next
    
29.    For Each A In .Range(MyId, MyId.End(xlDown))
    
30.    If A <> "總計" Then
    
31.       For i = 0 To d.Count
    
32.        If Ar(i) <> "" Then Ay(Ar(i)) = .Cells(A.Row, 1).Offset(, i).Value
    
33.       Next
    
34.    ReDim Preserve Ary(n)
    
35.    Ary(n) = Ay
    
36.    n = n + 1
    
37.    End If
    
38.    ReDim Ay(0 To d.Count)
    
39.    Next
    
40.    End With
    
41.     s = 0
    
42. Next
    
43. .[A1].Resize(n, d.Count) = Application.Transpose(Application.Transpose(Ary))
    
44. .Cells.EntireColumn.AutoFit
    
45. ActiveWindow.Zoom = 75
    
46. End With
    
47. Application.DisplayAlerts = True
    
48. End Sub

複製代碼

把分表彙整成總表
試試不同的思維
採購需求統計表.rar (71.76 KB)

下載次數: 30

2010-6-21 15:52