ADO汇总-自动去除链接: Sub total() Dim Sql$, strTbl$, i% Dim Filename As Variant UserForm1.Hide Filename = Application.GetOpenFilename("Microsoft Office Excel Files (*.xls), *.xls", , "请选取文件", , True) If Not IsArray(Filename) Then Exit Sub '如果未选取文件,则退出程序 For i = 1 To UBound(Filename) Set cn = CreateObject("ADODB.Connection") cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;IMEX=1;HDR=NO';Data Source=" & Filename(i) For Each sh In ActiveWorkbook.Worksheets '对文件中的表遍历 strTbl = sh.Name '当前表的名称 If strTbl <> "启动汇总" Then rowend = ThisWorkbook.Sheets(strTbl).[a65536].End(xlUp).Row + 1 If i = 1 Then '如果是第一个文件,则先做汇总表清空操作 [5:10000].ClearContents rowend = 3 End If With UserForm1 Sql = "Select * FROM [" & strTbl & "$" & .TextBox1.Text & .TextBox2.Text & ":" & .TextBox3.Text & .TextBox4.Text & "] " ThisWorkbook.Sheets(strTbl).Range(.TextBox1.Text & rowend).CopyFromRecordset cn.Execute(Sql) End With End If Next cn.Close '关闭当前文件连接 Next Sheets("2006年1月").Activate Set cn = Nothing Application.ScreenUpdating = True End Sub
jXjAcXkg.rar
(214.15 KB, 下载次数: 131)
|