[已解决]vb周报表汇总

飞云流水

大师帮忙把不同车间数据汇总至汇总表，有点麻烦，请各位看看！多谢！

最佳答案

月排行榜 / 总排行榜

tianti

2011-12-3 10:49

汇总表 和 三个子表要放在一个文件夹下， 然后在汇总表中插入以下代码，

1. Option Explicit
   
2. 
   
3. Sub 汇总周报数据()
   
4.    Dim i As Integer, j As Integer
   
5.    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
   
6.     j = -2
   
7.     For i = 1 To Windows.Count
   
8.         If Windows(i).Caption = "战狼队一车间周报.xlsx" Then
   
9.            Set wb1 = Workbooks("战狼队一车间周报.xlsx")
   
10.            Exit For
    
11.         End If
    
12.      Next
    
13.      For i = 1 To Windows.Count
    
14.         If Windows(i).Caption = "雄鹰队二车间周报.xlsx" Then
    
15.            Set wb2 = Workbooks("雄鹰队二车间周报.xlsx")
    
16.            Exit For
    
17.         End If
    
18.      Next
    
19.      For i = 1 To Windows.Count
    
20.         If Windows(i).Caption = "飞虎队三车间周报.xlsx" Then
    
21.            Set wb3 = Workbooks("飞虎队三车间周报.xlsx")
    
22.            Exit For
    
23.         End If
    
24.      Next
    
25.      If wb1 Is Nothing Then Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\战狼队一车间周报.xlsx")
    
26.      If wb2 Is Nothing Then Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\雄鹰队二车间周报.xlsx")
    
27.      If wb3 Is Nothing Then Set wb3 = Workbooks.Open(ThisWorkbook.Path & "\飞虎队三车间周报.xlsx")
    
28.     For i = 3 To 5000 Step 5
    
29. 
    
30.        If wb1.Sheets(1).Range("f" & i) = "" And wb2.Sheets(1).Range("f" & i) = "" And wb3.Sheets(1).Range("f" & i) = "" Then
    
31.            Exit For
    
32.         End If
    
33.         j = j + 5
    
34.         wb1.Sheets(1).Range("f" & i).Resize(5, 11).Copy ThisWorkbook.Sheets(1).Range("f" & j)
    
35.         j = j + 5
    
36.         wb2.Sheets(1).Range("f" & i).Resize(5, 11).Copy ThisWorkbook.Sheets(1).Range("f" & j)
    
37.         j = j + 5
    
38.         wb3.Sheets(1).Range("f" & i).Resize(5, 11).Copy ThisWorkbook.Sheets(1).Range("f" & j)
    
39.      Next
    
40.      wb1.Close True
    
41.      wb2.Close True
    
42.      wb3.Close True
    
43.      
    
44. End Sub
    

复制代码

跳转到最佳答案楼层

飞云流水

大师拜拜帮帮忙！小弟在此谢过了！

飞云流水

飞云流水 发表于 2011-12-2 17:29
大师拜拜帮帮忙！小弟在此谢过了！

有人吗，咋没有人回复我呀

tianti

汇总表 和 三个子表要放在一个文件夹下， 然后在汇总表中插入以下代码，

1. Option Explicit
   
2. 
   
3. Sub 汇总周报数据()
   
4.    Dim i As Integer, j As Integer
   
5.    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
   
6.     j = -2
   
7.     For i = 1 To Windows.Count
   
8.         If Windows(i).Caption = "战狼队一车间周报.xlsx" Then
   
9.            Set wb1 = Workbooks("战狼队一车间周报.xlsx")
   
10.            Exit For
    
11.         End If
    
12.      Next
    
13.      For i = 1 To Windows.Count
    
14.         If Windows(i).Caption = "雄鹰队二车间周报.xlsx" Then
    
15.            Set wb2 = Workbooks("雄鹰队二车间周报.xlsx")
    
16.            Exit For
    
17.         End If
    
18.      Next
    
19.      For i = 1 To Windows.Count
    
20.         If Windows(i).Caption = "飞虎队三车间周报.xlsx" Then
    
21.            Set wb3 = Workbooks("飞虎队三车间周报.xlsx")
    
22.            Exit For
    
23.         End If
    
24.      Next
    
25.      If wb1 Is Nothing Then Set wb1 = Workbooks.Open(ThisWorkbook.Path & "\战狼队一车间周报.xlsx")
    
26.      If wb2 Is Nothing Then Set wb2 = Workbooks.Open(ThisWorkbook.Path & "\雄鹰队二车间周报.xlsx")
    
27.      If wb3 Is Nothing Then Set wb3 = Workbooks.Open(ThisWorkbook.Path & "\飞虎队三车间周报.xlsx")
    
28.     For i = 3 To 5000 Step 5
    
29. 
    
30.        If wb1.Sheets(1).Range("f" & i) = "" And wb2.Sheets(1).Range("f" & i) = "" And wb3.Sheets(1).Range("f" & i) = "" Then
    
31.            Exit For
    
32.         End If
    
33.         j = j + 5
    
34.         wb1.Sheets(1).Range("f" & i).Resize(5, 11).Copy ThisWorkbook.Sheets(1).Range("f" & j)
    
35.         j = j + 5
    
36.         wb2.Sheets(1).Range("f" & i).Resize(5, 11).Copy ThisWorkbook.Sheets(1).Range("f" & j)
    
37.         j = j + 5
    
38.         wb3.Sheets(1).Range("f" & i).Resize(5, 11).Copy ThisWorkbook.Sheets(1).Range("f" & j)
    
39.      Next
    
40.      wb1.Close True
    
41.      wb2.Close True
    
42.      wb3.Close True
    
43.      
    
44. End Sub
    

复制代码

飞云流水

tianti 发表于 2011-12-3 10:49
汇总表 和 三个子表要放在一个文件夹下， 然后在汇总表中插入以下代码，

多谢老师帮忙，谢谢了