跪求大佬们帮忙啊，每天工作都要用到，谢谢大家了

流水年华zibo

VBA小白一个，表格中的订单每天都有录入另一个表格，求大神们帮忙合并一下就好了，谢谢大家

longwin

开了这么多帖子

quqiyuan

参与一下，供参考。。。

ynzsvt

99的统计了。

1. Sub YnZsVt()
   
2. Set sht = ThisWorkbook.Sheets("sheet2")
   
3. ReDim brr(1 To 10000, 1 To 7)
   
4. For Each sh In ThisWorkbook.Worksheets
   
5.   If Not sh.Name Like "Sheet*" Then
   
6.    arr = sh.UsedRange: f99 = 0
   
7.    For i = 7 To UBound(arr)
   
8.     If arr(i, 1) <> "备  注:" Then
   
9.      If arr(i, 1) = "99" Then
   
10.       If f99 = 0 Then n = n + 1: f99 = -1
    
11.       brr(n, 1) = arr(3, 6)
    
12.       brr(n, 2) = arr(2, 6)
    
13.       brr(n, 3) = Split(arr(2, 2), "·")(1)
    
14.       brr(n, 4) = arr(i, 1)
    
15.       brr(n, 7) = brr(n, 7) + Val(Mid(arr(i, 7), 3, 99))
    
16.      Else
    
17.       n = n + 1
    
18.       brr(n, 1) = arr(3, 6)
    
19.       brr(n, 2) = arr(2, 6)
    
20.       brr(n, 3) = Split(arr(2, 2), "·")(1)
    
21.       brr(n, 4) = arr(i, 1)
    
22.       brr(n, 5) = arr(i, 5)
    
23.       brr(n, 6) = Val(arr(i, 6))
    
24.       brr(n, 7) = arr(i, 7)
    
25.      End If
    
26.     Else
    
27.      Exit For
    
28.     End If
    
29.    Next
    
30.   End If
    
31. Next
    
32. With sht
    
33.   .UsedRange.Offset(42).Clear
    
34.   With .[a42].Resize(n, 7)
    
35.    .Value = brr
    
36.    .Borders.LineStyle = 1
    
37.    .HorizontalAlignment = xlCenter
    
38.    .Font.Size = 12
    
39.   End With
    
40.   .UsedRange.Columns.AutoFit
    
41. End With
    
42. Beep
    
43. End Sub
    

复制代码

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()            '//2024.6.16  多表合并
   
2.     Application.ScreenUpdating = False
   
3.     Application.DisplayAlerts = False
   
4.     Dim t: t = Timer
   
5.     Dim arr, brr(1 To 9999, 1 To 7)
   
6.     Set sh = Sheets("汇总")
   
7.     For Each sht In Sheets
   
8.         If sht.Name <> sh.Name Then
   
9.             With sht
   
10.                 r = .UsedRange.Find("合计:").Row
    
11.                 For i = 7 To r - 1
    
12.                     If Val(.Cells(i, 1)) Then
    
13.                         m = m + 1
    
14.                         brr(m, 1) = .[f3].Value
    
15.                         brr(m, 2) = .[f2].Value
    
16.                         brr(m, 3) = Split(.[b1].Value, "-")(1)
    
17.                         brr(m, 4) = .Cells(i, 1)
    
18.                         brr(m, 5) = .Cells(i, 5)
    
19.                         brr(m, 6) = .Cells(i, 6)
    
20.                         brr(m, 7) = .Cells(i, 7)
    
21.                     End If
    
22.                 Next i
    
23.             End With
    
24.         End If
    
25.     Next
    
26.     With sh
    
27.         .UsedRange.Offset(1).Clear
    
28.         .[a1].Resize(1, 7).Interior.Color = 49407
    
29.         .Columns(4).NumberFormatLocal = "@"
    
30.         With .[a2].Resize(m, 7)
    
31.             .Value = brr
    
32.             .Borders.LineStyle = 1
    
33.             .HorizontalAlignment = xlCenter
    
34.             .VerticalAlignment = xlCenter
    
35.         End With
    
36.     End With
    
37.     MsgBox "运行完毕，共用时： " & Format(Timer - t, "0.000秒")
    
38. End Sub
    

复制代码