在同一工作簿内的几个表合并成一个表，并且进行汇总

一任清风

有哪位老师能不能帮忙：将同一个工作簿内的几个表合并成一个表，并且在另一个表内进行汇总（用VBA）见附件

一任清风

哪位老师帮帮忙

№①布鲑鲑

一任清风 发表于 2013-4-20 14:19
哪位老师帮帮忙

1. Sub hbhz()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set a = Sheets("汇总"): Set b = Sheets("全体")
   
4.     b.Range("a3:d" & b.Range("a" & Rows.Count).End(3).Row + 1).Clear
   
5.     For Each sh In Sheets
   
6.         If sh.Name <> "汇总" And sh.Name <> "全体" Then
   
7.             x = b.Range("a" & Rows.Count).End(3).Row + 1
   
8.             y = sh.Range("a" & Rows.Count).End(3).Row
   
9.             sh.Range("a3:d" & y).Copy b.Range("a" & x)
   
10.         End If
    
11.     Next
    
12.     arr = b.UsedRange
    
13.     ReDim brr(1 To UBound(arr), 1 To 4)
    
14.     For i = 3 To UBound(arr)
    
15.         k = Application.Match(arr(i, 4), Rows(2), 0)
    
16.         If Not d.Exists(arr(i, 1)) Then
    
17.             m = m + 1: d(arr(i, 1)) = m: brr(m, 1) = arr(i, 1)
    
18.             brr(m, k) = 1
    
19.         Else
    
20.             brr(d(arr(i, 1)), k) = brr(d(arr(i, 1)), k) + 1
    
21.         End If
    
22.     Next
    
23.     a.Range("a3").Resize(m, 4) = brr
    
24.     a.[a2].Resize(m + 1, 4).Borders.LineStyle = xlContinuous
    
25. End Sub

复制代码

№①布鲑鲑

。。。。。。。。

一任清风

太感谢了,这是这个样子的

bluexuemei

1. Sub test()
   
2. 
   
3.      Dim cnn, SQL$
   
4.      Set cnn = CreateObject("adodb.connection")
   
5.      cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;';data source=" & ThisWorkbook.FullName
   
6.      For i = 3 To Sheets.Count
   
7.      SQL = SQL & "select * from [" & Sheets(i).Name & "$] union all "
   
8.      Next
   
9.      SQL = Left(SQL, Len(SQL) - 11)
   
10.      Debug.Print SQL
    
11.      Sheet2.Range("a3").CopyFromRecordset cnn.Execute(SQL)
    
12.      SQL1 = "transform count(手术种类) select 管理单位 from [全体$] group by 管理单位 pivot 手术种类"
    
13.      Sheet1.Range("a3").CopyFromRecordset cnn.Execute(SQL1)
    
14.      cnn.Close
    
15.      Set cnn = Nothing
    
16. End Sub
    
17. 
    

复制代码

LMY123

transform与字典