VBA+ADO汇总文件夹中的工作簿

qdzhxg

各位坛友：
      小弟下面这段代码，可以实现自动汇总文件中所有工作簿所需的内容，也许对有些人有用，现把代码和事例分享出来，希望能给予有缘人些许帮助。

      模块中代码如下：
      Sub 汇总()
Dim sh As Worksheet
Dim cn As Object, rst As Object
Dim s1 As String, s2 As String, SQL As String
Dim i As Long, j As Long
Set cn = CreateObject("adodb.connection")
Set rst = CreateObject("ADODB.Recordset")
Cells(2, 1).Resize(10000, 200).ClearContents
s1 = Dir(ThisWorkbook.Path & "\*.xls")
Do While s1 <> ""
    If s1 <> "Jumper装箱单列表.xls" Then
          cn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;';data source= " & ThisWorkbook.Path & "\" & s1
           j = Cells(Rows.Count, 2).End(xlUp).Row + 1
           SQL = "select * from [进出口$a15:u200]"
           Cells(j, 1).CopyFromRecordset cn.Execute(SQL)
   
       cn.Close
    End If
s1 = Dir
Loop
End Sub

       thisworkbook中代码如下：
       Private Sub Workbook_Open()
Call 汇总
Dim i As Long
Cells(1, "u").Select
Cells(1, 1).Resize(50000, 21).Sort key1:=Range("u1"), key2:=Range("t1"), Header:=xlYes
End Sub

qdzhxg

  同时，还有一个问题，想向高手们请教。

      分表中某些表格中涉及到单元格合并的问题，如附件中8月6日表格中，见图片一。合并的单元格，经汇总处理后自动取消合并，但这个合并是有必要的，需要在汇总后的表格中再次合并。请教各位，有什么办法可以实现这种效果。
   

freeffly

不錯的東西
收下學習