[已解决]数据筛选后导出生成新工作簿

cyj153

筛选导出生成新工作簿.rar (39.77 KB, 下载次数: 14)

2014-3-20 09:16 上传

点击文件名下载附件
附件内已述要求，谢谢老师们！

最佳答案

月排行榜 / 总排行榜

xdragon

2014-3-20 09:37

1. Private Sub CommandButton1_Click()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, SQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName
   
8.     Select Case Application.Version * 1
   
9.     Case Is <= 11
   
10.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
11.     Case Is >= 12
    
12.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
13.     End Select
    
14. 
    
15.     Conn.Open strConn
    
16.    
    
17.     SQL = "select * from [3$A:L] where 类别='" & ComboBox1.Value & "'"
    
18.     Set Rst = Conn.Execute(SQL)
    
19.     Application.ScreenUpdating = False
    
20.     Workbooks.Add
    
21.    
    
22.     With ActiveSheet
    
23.         For i = 0 To Rst.Fields.Count - 1
    
24.             .Cells(1, i + 1) = Rst.Fields(i).Name
    
25.         Next i
    
26.         .Range("A2").CopyFromRecordset Rst
    
27.         .Cells.EntireColumn.AutoFit
    
28.     End With
    
29.     ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & ComboBox1.Value
    
30.     ActiveWorkbook.Close
    
31.     Application.ScreenUpdating = True
    
32.     Rst.Close
    
33.     Conn.Close
    
34.     Set Conn = Nothing
    
35.     Set Rst = Nothing
    
36. End Sub

复制代码

跳转到最佳答案楼层

xdragon

1. Private Sub CommandButton1_Click()
   
2.     Dim Conn As Object, Rst As Object
   
3.     Dim strConn As String, SQL As String
   
4.     Dim i As Integer, PathStr As String
   
5.     Set Conn = CreateObject("ADODB.Connection")
   
6.     Set Rst = CreateObject("ADODB.Recordset")
   
7.     PathStr = ThisWorkbook.FullName
   
8.     Select Case Application.Version * 1
   
9.     Case Is <= 11
   
10.         strConn = "Provider=Microsoft.Jet.Oledb.4.0;Extended Properties=excel 8.0;Data source=" & PathStr
    
11.     Case Is >= 12
    
12.         strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & PathStr & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
    
13.     End Select
    
14. 
    
15.     Conn.Open strConn
    
16.    
    
17.     SQL = "select * from [3$A:L] where 类别='" & ComboBox1.Value & "'"
    
18.     Set Rst = Conn.Execute(SQL)
    
19.     Application.ScreenUpdating = False
    
20.     Workbooks.Add
    
21.    
    
22.     With ActiveSheet
    
23.         For i = 0 To Rst.Fields.Count - 1
    
24.             .Cells(1, i + 1) = Rst.Fields(i).Name
    
25.         Next i
    
26.         .Range("A2").CopyFromRecordset Rst
    
27.         .Cells.EntireColumn.AutoFit
    
28.     End With
    
29.     ActiveWorkbook.SaveAs ThisWorkbook.Path & "" & ComboBox1.Value
    
30.     ActiveWorkbook.Close
    
31.     Application.ScreenUpdating = True
    
32.     Rst.Close
    
33.     Conn.Close
    
34.     Set Conn = Nothing
    
35.     Set Rst = Nothing
    
36. End Sub

复制代码