几个表格集合数据

cut

请教老师：表中有A,B,C表（表格行数不规律，会根据实际增加，减少行）

要求：从A,B,C三个表中，把A列为“一厂”的数据，复制到“一厂汇总表”，把A列为“二厂”的数据，复制到“二厂汇总表”，没有名称，没有名字的不复制
顺序要求：按日期
谢谢

lizhipei78

不难就是辛苦工

ykcbf1100

一厂汇总完毕，等下再写个二厂汇总。

ykcbf1100

一厂汇总。

1. Sub ykcbf()   '//2024.6.24  一厂汇总
   
2.     Application.ScreenUpdating = False
   
3.     ReDim brr(1 To 10000, 1 To 100)
   
4.     Set Sh = ThisWorkbook.Sheets("一厂汇总")
   
5.     st = Replace(Sh.Name, "汇总", "")
   
6.     b = [{1,2,3,4,5,6,10,12,13,14,15,16,17,18,19}]
   
7.     For Each Sht In Sheets
   
8.         If InStr(Sht.Name, "汇总") = 0 Then
   
9.             arr = Sht.UsedRange
   
10.             For i = 3 To UBound(arr)
    
11.                 If InStr(arr(i, 1), st) Then
    
12.                     m = m + 1
    
13.                     For j = 1 To UBound(b)
    
14.                         brr(m, j) = arr(i, b(j))
    
15.                     Next
    
16.                 End If
    
17.             Next
    
18.         End If
    
19.     Next
    
20.     With Sh
    
21.         .UsedRange.Offset(1).ClearContents
    
22.         .[a2].Resize(m, 15) = brr
    
23.     End With
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "OK！"
    
26. End Sub
    
27. 
    

复制代码

ykcbf1100

二厂汇总也写完了。

ykcbf1100

二厂汇总。。。

1. Sub ykcbf2()   '//2024.6.24  二厂汇总
   
2.     Application.ScreenUpdating = False
   
3.     ReDim brr(1 To 10000, 1 To 100)
   
4.     Set Sh = ThisWorkbook.Sheets("二厂汇总")
   
5.     st = Replace(Sh.Name, "汇总", "")
   
6.     For Each Sht In Sheets
   
7.         If InStr(Sht.Name, "汇总") = 0 Then
   
8.             arr = Sht.UsedRange
   
9.             For i = 3 To UBound(arr)
   
10.                 If InStr(arr(i, 1), st) Then
    
11.                     m = m + 1
    
12.                     For j = 1 To UBound(arr, 2)
    
13.                         brr(m, j) = arr(i, j)
    
14.                     Next
    
15.                 End If
    
16.             Next
    
17.         End If
    
18.     Next
    
19.     With Sh
    
20.         .UsedRange.Offset(3).Clear
    
21.         With .[a4].Resize(m, 20)
    
22.             .Value = brr
    
23.             .Borders.LineStyle = 1
    
24.             .HorizontalAlignment = xlCenter
    
25.             .VerticalAlignment = xlCenter
    
26.         End With
    
27.     End With
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "OK！"
    
30. End Sub
    
31. 
    

复制代码

cut

谢谢老师，问题解决了，非常感谢