小妖同学请进！！！

roych

看样子，被点名的小妖同学缺席了？{:soso_e128:}。
俺用ADO随便做了一个。实际上，用内存数组会更好些，只是写起来也更加麻烦，主要因为多维数组切换成一维数组实在不方便。

1. 
   
2. '注意事项:  1、在表1上需要加一行表头。
   
3. '           2、需要引用ADO库（Microsoft ActiveX Data Object），可能版本号不同，但不影响使用。
   
4. '           3、使用前必须确保先启用宏(Office2003 版位置：工具\宏\宏安全性；
   
5. '                                   2010版本位置：文件\选项\受信任中心\受信任中心设置\宏设置）。
   
6. '           4、如果修改其它内容，请修改ssql语句和其它相关内容以适。
   
7. 
   
8. '编写： Roych
   
9. '日期： 2012-12-13
   
10. 
    
11. Sub ImpData()
    
12. Dim cnn As New ADODB.Connection
    
13. Dim rst As New ADODB.Recordset
    
14. Dim ssql As String
    
15. Sheets("表2").Range("A:B").ClearContents
    
16. cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
    
17. ssql = "select * from( select 公司,产品1 from [表1$] union select 公司,产品2 from [表1$] union " _
    
18.         & "select 公司,产品3 from [表1$] union select 公司,产品4 from [表1$] union " _
    
19.         & "select 公司,产品5 from [表1$] union select 公司,产品6 from [表1$] union " _
    
20.         & "select 公司,产品7 from [表1$] union select 公司,产品8 from [表1$] union " _
    
21.         & "select 公司,产品8 from [表1$] union select 公司,产品10 from [表1$] union " _
    
22.         & "select 公司,产品11 from [表1$] union select 公司,产品12 from [表1$] union " _
    
23.         & "select 公司,产品13 from [表1$] union select 公司,产品14 from [表1$] union " _
    
24.         & "select 公司,产品15 from [表1$] union select 公司,产品16 from [表1$] )  where isnull(产品1)=False"
    
25. rst.Open ssql, cnn, adOpenKeyset, adLockOptimistic
    
26. Sheets("表2").[a1].CopyFromRecordset rst
    
27. rst.Close
    
28. Set rst = Nothing
    
29. cnn.Close
    
30. Set cnn = Nothing
    
31. End Sub

复制代码