大家帮帮忙

308964903

常常要到网站上去查一些信息，把结果分别 放到指定表格里，  求代码 ，谢谢  ，有酬谢

cwpccna

1. 'http://club.excelhome.net/thread-1341555-1-1.html
   
2. Sub test()
   
3.   Dim cnn As Object, SQL As String, MyPath$, MyFile$, n As Long
   
4. '  Cells.Clear
   
5.   Set cnn = CreateObject("ADODB.Connection")
   
6.   MyPath = ThisWorkbook.Path & ""
   
7.   MyFile = Dir(MyPath & "*.xlsx")
   
8.   Do While MyFile <> ""
   
9.      If MyFile <> ThisWorkbook.Name Then
   
10.         n = n + 1
    
11.         If n = 1 Then
    
12.             cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;hdr=no';Data Source=" & MyPath & MyFile
    
13.            SQL = "SELECT * FROM [设计评审表$A17:BO17] WHERE F1 IS NOT NULL"
    
14.         Else
    
15.            SQL = SQL & " UNION ALL SELECT * FROM [Excel 12.0;HDR=NO;Database=" & MyPath & MyFile & "].[设计评审表$A17:BO17] "
    
16.         End If
    
17.      End If
    
18.     MyFile = Dir()
    
19.   Loop
    
20.   Range("A4").CopyFromRecordset cnn.Execute(SQL)
    
21.   cnn.Close
    
22.   Set cnn = Nothing
    
23. End Sub

复制代码

308964903

帐号就是我的QQ 30****3

308964903

楼上有空吗？   怎么联系你， 帮我搞完他，我给报酬，谢谢