不打开工作簿提取数据

zhu086

不打开表1和表2，将工作表1表2整个工作簿的数据分别导入“O”和“K"表，如果检测到没有表2工作薄，就不导入


不打开工作表导入EXCEL.zip (4.94 KB, 下载次数: 478)

2014-7-4 10:36 上传

点击文件名下载附件

zhaogang1960

请参考：

1. Sub ADO法()
   
2.     Dim cnn As Object, rs As Object, SQL$, myPath$, MyFile$, i&, m&
   
3.     myPath = ThisWorkbook.Path & ""
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='text;FMT=DELIMITED';Data Source=" & myPath
   
6.     MyFile = Dir(myPath & "*.csv")
   
7.     Do While MyFile <> ""
   
8.         SQL = "select * from " & MyFile
   
9.         Set rs = cnn.Execute(SQL)
   
10.         m = m + 1
    
11.         With Sheets(m)
    
12.             .Cells.ClearContents
    
13.             For i = 1 To rs.Fields.Count
    
14.                 .Cells(1, i) = rs.Fields(i - 1).Name
    
15.             Next
    
16.             .[a2].CopyFromRecordset rs
    
17.         End With
    
18.         MyFile = Dir()
    
19.     Loop
    
20.     rs.Close
    
21.     cnn.Close
    
22.     Set rs = Nothing
    
23.     Set cnn = Nothing
    
24. End Sub
    

复制代码

zhaogang1960

请测试附件
不打开工作表导入EXCEL.rar (9.14 KB, 下载次数: 226)

2014-7-4 11:41 上传

点击文件名下载附件

zhu086

zhaogang1960 发表于 2014-7-4 11:41
请测试附件

非常感谢老师帮忙，单独放在一个文件夹里，测试可以用，如果三个工作表都放在桌面测试就会出现错误

zhaogang1960

zhu086 发表于 2014-7-4 11:53
非常感谢老师帮忙，单独放在一个文件夹里，测试可以用，如果三个工作表都放在桌面测试就会出现错误

只有查询"1.csv", "2.csv"两个文件？如果是：

1. Sub ADO法()
   
2.     Dim cnn As Object, rs As Object, SQL$, i&, m&, c
   
3.     myPath = ThisWorkbook.Path & ""
   
4.     Set cnn = CreateObject("adodb.connection")
   
5.     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='text;FMT=DELIMITED';Data Source=" & myPath
   
6.     For Each c In Array("1.csv", "2.csv")
   
7.         m = m + 1
   
8.         If Dir(myPath & c) <> "" Then
   
9.             SQL = "select * from " & c
   
10.             Set rs = cnn.Execute(SQL)
    
11.             With Sheets(m)
    
12.                 .Cells.ClearContents
    
13.                 For i = 1 To rs.Fields.Count
    
14.                     .Cells(1, i) = rs.Fields(i - 1).Name
    
15.                 Next
    
16.                 .[a2].CopyFromRecordset rs
    
17.             End With
    
18.         End If
    
19.     Next
    
20.     rs.Close
    
21.     cnn.Close
    
22.     Set rs = Nothing
    
23.     Set cnn = Nothing
    
24. End Sub
    
25. 
    

复制代码

zhaogang1960

请测试附件
不打开工作表导入EXCEL.rar (9.95 KB, 下载次数: 264)

2014-7-4 12:03 上传

点击文件名下载附件

zhu086

zhaogang1960 发表于 2014-7-4 12:04
请测试附件

非常完美，谢谢老师

zhu086

zhaogang1960 发表于 2014-7-4 12:04
请测试附件

    On Error Resume Next
      Range("i:i").Replace "*等待买家付款*", ""
   Range("i:i").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

       Range("i:i").Replace "*交易关闭*", ""
    Range("i:i").SpecialCells(xlCellTypeBlanks).EntireRow.Delete


不打开表1，表2，需要在表1表2里执行这个代码并保存表格的代码，请问老师要什么写

zhaogang1960

zhu086 发表于 2014-7-4 14:30
On Error Resume Next
      Range("i:i").Replace "*等待买家付款*", ""
   Range("i:i").Special ...

表1，表2都是csv文件，不是工作簿
请模拟效果，即你想达到的结果

mmwwdd

嗯，我也是想这产做