急：一个表中，多个sheet表合并汇总

rade

高手啊！

rade

学习了！！

[ 本帖最后由 rade 于 2011-5-20 14:41 编辑 ]

皮皮母虾

alzbz 发表于 2011-5-15 15:01
用VBA很容易的。

这个是怎么做到的呀

皮皮母虾

皮皮母虾 发表于 2012-12-24 14:02
这个是怎么做到的呀

想学习一下呀

fu123

好好学习,谢谢分享

ykcbf1100

借题练习，多表合并，VBA

ykcbf1100

1. Sub ykcbf()   '//2025.4.9
   
2.     Application.ScreenUpdating = False
   
3.     Set sh = ThisWorkbook.Sheets("汇总表")
   
4.     ReDim brr(1 To 10 ^ 5, 1 To 100)
   
5.     On Error Resume Next
   
6.     For Each sht In Sheets
   
7.         If sht.Name <> sh.Name Then
   
8.             m = m + 1
   
9.             brr(m, 1) = m
   
10.             With sht
    
11.                 r = .Columns(1).Find("合计").Row
    
12.                 brr(m, 2) = .Name
    
13.                 brr(m, 3) = .[d2]
    
14.                 brr(m, 4) = .[b2]
    
15.                 brr(m, 6) = .[b4]
    
16.                 brr(m, 5) = IIf(brr(m, 4) = Empty, "", VBA.Round(brr(m, 6) / brr(m, 4), 2))
    
17.                 brr(m, 7) = .[d3]
    
18.                 brr(m, 8) = .[b3]
    
19.                 brr(m, 9) = .Cells(r, 5)
    
20.                 brr(m, 10) = .Cells(r, 2)
    
21.                 brr(m, 11) = .Cells(r, 8)
    
22.                 brr(m, 12) = brr(m, 6) - brr(m, 9)
    
23.             End With
    
24.         End If
    
25.     Next
    
26.     With sh
    
27.         .UsedRange.Offset(2) = Empty
    
28.         .[a3].Resize(m, 12) = brr
    
29.         .[a3].Resize(m, 12).Borders.LineStyle = 1
    
30.         ActiveWindow.DisplayZeros = False
    
31.     End With
    
32.     Application.ScreenUpdating = True
    
33.     MsgBox "OK！"
    
34. End Sub
    
35. 
    

复制代码