[發問] 如何將不同工作表的內表單資料匯總到同一工作表內

wendy

如何將不同工作表的內表單資料匯總到同一工作表內, 且匯總工作表的欄位可能與來源是不相對應欄
採購需求統計表.rar (33.66 KB)

下載次數: 21

2010-6-19 23:14

GBKEE

回復 1# wendy
試試看

1. Sub Ex()
   
2.     Dim Sh As Worksheet, R As Range, C As Range, S$, d(1 To 3) As Object, Ar
   
3.     Set d(1) = CreateObject("scripting.dictionary")
   
4.     Set d(2) = CreateObject("scripting.dictionary")
   
5.     Set d(3) = CreateObject("scripting.dictionary")
   
6.     Ar = Join(Application.Transpose(Application.Transpose(Sheets("1").[A3:F3])), ",")
   
7.     For Each Sh In Sheets(Array("1", "2", "3", "4"))
   
8.         With Sh
   
9.             For Each R In .Range("g3", .Range("iv3").End(xlToLeft)(1, 0))
   
10.                 d(1)(R.Value) = ""
    
11.                 For Each C In .Range(R(2, 1), .Cells(.Range("F" & Rows.Count).End(xlUp).Row - 1, R.Column)).SpecialCells(xlCellTypeConstants)
    
12.                     If C <> "" Then
    
13.                         S = R.Value & Join(Application.Transpose(Application.Transpose(.Cells(C.Row, "A").Cells.Resize(1, 6).Value)), "")
    
14.                         d(2)(S) = C.Value
    
15.                         S = Join(Application.Transpose(Application.Transpose(.Cells(C.Row, "A").Cells.Resize(1, 6).Value)), "")
    
16.                         d(3)(S) = .Cells(C.Row, "A").Cells.Resize(1, 6).Value
    
17.                     End If
    
18.                 Next
    
19.             Next
    
20.         End With
    
21.     Next
    
22.     With Sheets("要匯整的總表")
    
23.         .Cells.Clear
    
24.         Ar = Split(Ar & "," & Join(d(1).keys, ","), ",")
    
25.         .[A1].Resize(, UBound(Ar) + 1) = Ar
    
26.         .[A2].Resize(d(3).Count, 6) = Application.Transpose(Application.Transpose(d(3).items))
    
27.         For Each R In .Range("a1").CurrentRegion.Columns
    
28.             If R.Column > 6 Then
    
29.                 For Each C In R.Cells
    
30.                     S = R.Cells(1) & Join(Application.Transpose(Application.Transpose(.Cells(C.Row, "A").Cells.Resize(1, 6).Value)), "")
    
31.                     If d(2).Exists(S) Then C = d(2)(S)
    
32.                 Next
    
33.             End If
    
34.         Next
    
35.         .Range("a1").CurrentRegion.Sort KEY1:=.[A1], KEY2:=.[F1], Header:=xlYes
    
36.         
    
37.         Set R = .Range("a1").CurrentRegion
    
38.         Set R = .Range("a1").CurrentRegion.Cells(R.Rows.Count, R.Columns.Count)
    
39.         
    
40.         .Cells(R.Row + 1, "F") = "總計"
    
41.         .Range(.Cells(R.Row + 1, "G"), R.Offset(1)) = "=SUM(R2C:R[-1]C)"
    
42.         .Range(.Cells(R.Row + 1, "G"), R.Offset(1)).Value = .Range(.Cells(R.Row + 1, "G"), R.Offset(1)).Value
    
43.         
    
44.         .Cells(1, R.Column + 1) = "總計"
    
45.         .Range(.Cells(2, R.Column + 1), R.Offset(, 1)) = "=SUM(RC7:RC[-1])"
    
46.         .Range(.Cells(2, R.Column + 1), R.Offset(, 1)).Value = .Range(.Cells(2, R.Column + 1), R.Offset(, 1)).Value
    
47.     End With
    
48. End Sub

複製代碼

wendy

感恩,,   我先試試, 但好丟臉的是,沒有學過任何程式設計, 所以要直接套用後,, 再慢慢往回研究, 有人可以直接教授就太好了!!  excel 函數我是可以從 " ? " 中自學,  所以我努力的在爭取積分, 才可以從別人的實例中學習 !!!    """ 書到用時方恨少"

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

wendy

謝謝先輩的資料,, 我先試試,,  

HUNGCHILIN

建議先學習樞紐分析
再回頭來看看你的表
相信會有更多收穫

wendy

謝謝建議,,我會多努力,,,