归纳与总结，以备自查！

ctp_119

open方法：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Application.ScreenUpdating = False
   
3. Application.EnableEvents = False
   
4. If Target.Row <> 1 Or Target.Column <> 3 Then Exit Sub
   
5. Dim i As Integer, j As Integer
   
6. Dim wb As Workbook
   
7. Dim sh As Worksheet
   
8. Dim arr As Variant
   
9. Dim brr(1 To 5) As Variant
   
10. Set wb = Workbooks.Open(ThisWorkbook.Path & "\1.xlsx", , , , "123")
    
11. Set sh = wb.Sheets("工作表1")
    
12. j = sh.[a65536].End(xlUp).Row
    
13. arr = sh.Range("a2:e" & j)
    
14. For i = 1 To UBound(arr)
    
15.     If arr(i, 1) = Target.Value Then
    
16.     brr(1) = arr(i, 1)
    
17.     brr(2) = arr(i, 2)
    
18.     brr(3) = arr(i, 3)
    
19.     brr(4) = arr(i, 4)
    
20.     brr(5) = arr(i, 5)
    
21.     Exit For
    
22.     End If
    
23. Next
    
24. wb.Close True
    
25. Range("a4").Resize(1, 5) = brr
    
26. Application.EnableEvents = True
    
27. Application.ScreenUpdating = True
    
28. End Sub
    

复制代码

ctp_119

getobject方法读取文件：这个方法要注意了。

1. Sub 合并()
   
2.     Dim arr()
   
3.     Dim n As Single
   
4.     Dim shs As Object
   
5.     Dim sh As Worksheet
   
6.     Dim tt As String
   
7.     Dim s As String, wj As String
   
8.     Application.ScreenUpdating = 0
   
9.     Application.DisplayAlerts = False
   
10.     s = ThisWorkbook.Path & ""
    
11.     wj = Dir(s & "*月.xls")
    
12.     tt = ThisWorkbook.Name
    
13.     n = 2
    
14.     Range("A1:E1") = Array("顺序", "客户简称", "入库", "出库", "吞吐")
    
15.     Do While wj <> ""                      '将各个工作簿复制到一起
    
16.         Set shs = GetObject(s & wj)
    
17.         Windows(shs.Name).Visible = True
    
18.         For Each sh In shs.Worksheets
    
19.             If InStr(sh.Name, "吞吐") Then
    
20.                 h = sh.Range("A2").End(4).Row - 1
    
21.                 Workbooks(tt).Activate
    
22.                 Range(Cells(n, 1), Cells(n + h - 3, 5)).Value = sh.Range("A3:E" & h).Value  '将各个表复制到一个表
    
23.                 n = n + h - 2
    
24.             End If
    
25.         Next
    
26.         a = 1
    
27.         Workbooks(wj).Close
    
28.         wj = Dir()
    
29.     Loop
    
30.     Application.DisplayAlerts = True
    
31.     Application.ScreenUpdating = 1
    
32.    ' Windows("小事").Visible = True
    
33. ThisWorkbook.IsAddin = True      '本行和下面一行联合使用。是因为上面一句有时候有问题，报错。
    
34. ThisWorkbook.IsAddin = False         '这样设置可以使其隐藏的工作表再次显现出来。不要问为什么？
    
35. End Sub
    

复制代码

ctp_119

ADO+SQL方法读取：

1. Sub ctp_119()
   
2. Dim cnn As Object
   
3. Dim sql As String
   
4. Dim sql2 As String
   
5. Set cnn = CreateObject("adodb.connection")
   
6. cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=YES';Data Source=" & ThisWorkbook.FullName
   
7. myPath = ThisWorkbook.Path & ""
   
8.     temp = Dir(myPath & "*终端销售量.xls")
   
9.     Do While temp <> ""
   
10.         If sql = "" Then
    
11.             sql = "SELECT * FROM `" & myPath & temp & "`.[终端捆绑用户信息查询$]"
    
12.         Else
    
13.             sql = sql & " UNION ALL SELECT * FROM `" & myPath & temp & "`.[终端捆绑用户信息查询$]"
    
14.         End If
    
15.         temp = Dir
    
16.     Loop
    
17. '[a2].CopyFromRecordset cnn.Execute(sql)
    
18. sql2 = "select * from (" & sql & ") where 单位 like '%YH'and 终端型号 not like '%社会%'"
    
19. Cells.Clear
    
20. [a2].CopyFromRecordset cnn.Execute(sql2)
    
21. Range("a1:c1") = Array("单位", "受理时间", "终端型号")
    
22. cnn.Close
    
23. Set cnn = Nothing
    
24. End Sub
    

复制代码

真无言

楼主辛苦，资料很有用。

真无言

请问若在D列有一列数量，我想在结果里各项目汇总一下不知如何加代码请指教。
Sub ctp_119()
Dim cnn As Object
Dim sql As String
Dim sql2 As String
Set cnn = CreateObject("adodb.connection")
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;HDR=YES';Data Source=" & ThisWorkbook.FullName
myPath = ThisWorkbook.Path & "\"
    temp = Dir(myPath & "*终端销售量.xls")
    Do While temp <> ""
        If sql = "" Then
            sql = "SELECT * FROM `" & myPath & temp & "`.[终端捆绑用户信息查询$]"
        Else
            sql = sql & " UNION ALL SELECT * FROM `" & myPath & temp & "`.[终端捆绑用户信息查询$]"
        End If
        temp = Dir
    Loop
'[a2].CopyFromRecordset cnn.Execute(sql)
sql2 = "select * from (" & sql & ") where 单位 like '%YH'and 终端型号 not like '%社会%'"
Cells.Clear
[a2].CopyFromRecordset cnn.Execute(sql2)
Range("a1:d1") = Array("单位", "受理时间", "终端型号", "数量")'汇总的数据
cnn.Close
Set cnn = Nothing
End Sub

ctp_119

真无言 发表于 2013-4-9 11:07
请问若在D列有一列数量，我想在结果里各项目汇总一下不知如何加代码请指教。
Sub ctp_119()
Dim cnn As O ...

加个sum函数和by分组即可。

lhsh36183

好教程，要好好学习。谢谢楼主的奉献精神。

dajiahaoxinku12

辛苦，感谢分享，我们一直都在努力！！！            

飞云楼主

谢谢楼主的奉献精神

lhsh36183

谢谢楼主的奉献精神,要好好学习学习。