利用两个excel，根据查询条件生成第三个excel

拙诚虎

各位老师好！
有一个需求求助。
有两个excel文件，
一个是记载学生信息表，其中有入校日期。
另一个是记载考试成绩和考试日期。
想用excel的宏，自动生成一个excel，那个excel中只有入校半年（6个月）以后的成绩。
（特殊要求是：执行宏的时候，不允许打开那两个excel文件。）
具体请参考附件。
这个学校校长要，多谢多谢！！！

feiren228

没有附件？？

feiren228

请测试》》》

1. Sub ado() 'by feiren228
   
2.     Dim cnn As Object, rs As Object, sql$
   
3.     Set cnn = CreateObject("Adodb.Connection")
   
4.     Set rs = CreateObject("adodb.recordset")
   
5.     p1$ = ThisWorkbook.Path & "\Student-info.xls"
   
6.     p2$ = ThisWorkbook.Path & "\Student-score.xls"
   
7.     If Application.Version * 1 <= 11 Then
   
8.         cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties='Excel 8.0;imex=1;hdr=yes';Data Source=" & ThisWorkbook.FullName
   
9.     Else
   
10.         cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;imex=1;hdr=yes';Data Source=" & ThisWorkbook.FullName
    
11.     End If
    
12.     sql = "select a.* from [Excel 8.0;imex=1;hdr=yes;Database=" & p2 & "].[sheet1$A2:K] a left join [Excel 8.0;imex=1;hdr=yes;Database=" & p1 & "].[sheet1$A2:C] b on a.学号=b.学号 where Month(a.考试日期 - b.入学日期)>=6"
    
13.     Set rs = cnn.Execute(sql)
    
14.     [a3:k10000] = ""
    
15.     [a3].CopyFromRecordset cnn.Execute(sql)
    
16.     rs.Close
    
17.     Set rs = Nothing
    
18.     Set cnn = Nothing
    
19. End Sub
    

复制代码

feiren228

。。。。。。。。。
request-test.zip (34.58 KB, 下载次数: 35)

2015-6-2 11:22 上传

点击文件名下载附件

拙诚虎

feiren228 发表于 2015-6-2 11:22
。。。。。。。。。

这么快，太厉害了！太感谢了！我测试一下看看。

拙诚虎

feiren228 发表于 2015-6-2 11:22
。。。。。。。。。

真诚感谢你的代码，能否兼容excel2013版和2003版。我的老板是excel2013，员工是excel2003.
另外，那个按钮如果加在Student-score.xls文件中，然后自动生成goal.xls文件，感激不尽！

拙诚虎

feiren228 发表于 2015-6-2 11:22
。。。。。。。。。

    If Application.Version * 1 <= 11 Then

        cnn.Open "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties='Excel 8.0;imex=1;hdr=yes';Data Source=" & ThisWorkbook.FullName

    Else

        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties='Excel 12.0;imex=1;hdr=yes';Data Source=" & ThisWorkbook.FullName

    End If
这段代码已经兼容了所有excel，非常感谢！

LMY123

sql = "select a.* from [Excel 8.0;imex=1;hdr=yes;Database=" & p2 & "].[sheet1$A2:K] a left join [Excel 8.0;imex=1;hdr=yes;Database=" & p1 & "].[sheet1$A2:C] b on a.学号=b.学号 where Month(a.考试日期 - b.入学日期)>=6"