求大神写个东西。

zhaogang1960

张雄友 发表于 2014-6-30 19:30
如果有标题怎么办？只要A1单元格一个标题就好了。

既然每列都是同一个标题，可以不写，仅写数据：

1. Sub ADO加数组法()
   
2.     Dim Fso As Object, File As Object, cnn As Object, SQL$
   
3.     Dim arr, brr(1 To 65536, 1 To 1), f As Boolean, i&, m&, n&
   
4.     Application.ScreenUpdating = False
   
5.     Application.StatusBar = "                           正在导入数据，请等待……"
   
6.     Cells.ClearContents
   
7.     Set Fso = CreateObject("Scripting.FileSystemObject")
   
8.     For Each File In Fso.GetFolder(ThisWorkbook.Path).Files
   
9.         If File.Name Like "*.xls" Then
   
10.             If File.Name <> ThisWorkbook.Name Then
    
11.                 If Not f Then
    
12.                     Set cnn = CreateObject("adodb.connection")
    
13.                     cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=yes';Data Source=" & File
    
14.                     SQL = "select 车间 from [Sheet1$o:o] where 车间 is not null"
    
15.                     f = True
    
16.                 Else
    
17.                     SQL = "select 车间 from [Excel 8.0;hdr=yes;Database=" & File & ";].[Sheet1$o:o] where 车间 is not null"
    
18.                 End If
    
19.                 arr = cnn.Execute(SQL).GetRows
    
20.                 For i = 0 To UBound(arr, 2)
    
21.                     m = m + 1
    
22.                     If m > 65536 Then
    
23.                         Cells(1, n + 1).Resize(65536) = brr
    
24.                         m = 1
    
25.                         n = n + 1
    
26.                         Erase brr
    
27.                     End If
    
28.                     brr(m, 1) = arr(0, i)
    
29.                 Next
    
30.             End If
    
31.         End If
    
32.     Next
    
33.     Cells(1, n + 1).Resize(m) = brr
    
34.     Set File = Nothing
    
35.     Set Fso = Nothing
    
36.     cnn.Close
    
37.     Set cnn = Nothing
    
38.     Application.StatusBar = False
    
39.     Application.ScreenUpdating = True
    
40. End Sub
    

复制代码

jiminyanyan

学习一下。。。。。

overchen

zhaogang1960 发表于 2014-6-30 18:59
没有用过wps，应该是ADO不认识wps文件格式

格式一样都是xls，我用你的那份实例的就正常，调试之后是这行错误。

zhaogang1960

overchen 发表于 2014-7-1 12:07
格式一样都是xls，我用你的那份实例的就正常，调试之后是这行错误。

那就是Wps程序不认识ADO
建议到专业Wps论坛问问吧

overchen

zhaogang1960 发表于 2014-7-1 15:20
那就是Wps程序不认识ADO
建议到专业Wps论坛问问吧

但是我用你给我的那个实例可以正常使用啊。

zhaogang1960

overchen 发表于 2014-7-1 19:14
但是我用你给我的那个实例可以正常使用啊。

我给你的实例是我本人用手工编辑的Excel工作簿，不知道你测试的是什么，能否传上来分析一下？

overchen

zhaogang1960 发表于 2014-7-1 19:20
我给你的实例是我本人用手工编辑的Excel工作簿，不知道你测试的是什么，能否传上来分析一下？

1 (1).zip (75.45 KB, 下载次数: 9)

2014-7-2 10:40 上传

点击文件名下载附件

你查看
我要O列的。

overchen

zhaogang1960 发表于 2014-7-1 19:20
我给你的实例是我本人用手工编辑的Excel工作簿，不知道你测试的是什么，能否传上来分析一下？

你好，方便添加下我的QQ吗？帮我解决下。2028521060

overchen

zhaogang1960 发表于 2014-7-1 19:20
我给你的实例是我本人用手工编辑的Excel工作簿，不知道你测试的是什么，能否传上来分析一下？

你好，在吗，我用OFFICE一样出现那个问题。

zhaogang1960

overchen 发表于 2014-7-4 14:44
你好，在吗，我用OFFICE一样出现那个问题。

请上传出错附件分析一下