Sub 四拾() Set X = CreateObject("ADODB.Connection") X.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=no;';Data Source=" & ThisWorkbook.FullName Sql = "( select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet1$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet2$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet3$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet4$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet5$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet6$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet7$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet8$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet9$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet10$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet11$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet12$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet13$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet14$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet15$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet16$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet17$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet18$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet19$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet20$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet21$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet22$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet23$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet24$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet25$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet26$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet27$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet28$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet29$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet30$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet31$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet32$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet33$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet34$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet35$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet36$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet37$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet38$] union all " Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet39$] union all " Sql = Sql & " select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet40$] ) a " Sql = " select v.cc,v.kk,w.ee from (select a.f1 as cc,count(*) as kk from " & Sql & " group by a.f1) v left join (select a.f1 as dd,count(a.aa) as ee from " & Sql & " where a.gg<0 and a.hh<0 and a.ll>0 or( a.ii<0 and a.jj<0 and a.ll>0 ) or( a.aa<0 and a.ff<0 and a.ll<0 ) or( a.gg<0 and a.hh<0 and a.ll<0 )or( a.aa<0 and a.ff<0 and a.ll=0 ) or( a.ii<0 and a.jj<0 and a.ll=0 )group by a.f1) w on v.cc=w.dd where v.cc is not null"
Set yy = X.Execute(Sql) Sheet381.[1:888].Clear Sheet381.[a1].CopyFromRecordset yy Set yy = Nothing: Set X = Nothing End Sub 这就是把sheet1-40工作表进行统计，把结果写在sheet381,但是不能同时统计41个以上的工作表，怎样办？
X.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties='Excel 8.0;hdr=no;';Data Source=" & ThisWorkbook.FullName
Sql = "( select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet1$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet2$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet3$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet4$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet5$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet6$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet7$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet8$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet9$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet10$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet11$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet12$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet13$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet14$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet15$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet16$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet17$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet18$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet19$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet20$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet21$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet22$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet23$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet24$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet25$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet26$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet27$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet28$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet29$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet30$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet31$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet32$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet33$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet34$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet35$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet36$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet37$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet38$] union all "
Sql = Sql & "select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet39$] union all "
Sql = Sql & " select f1,(f8-f9) as aa,(f8-f10)as ff,(f9-f8) as gg,(f9-f10) as hh,(f10-f8)as ii,(f10-f9)as jj,(f12-f13) as ll from [sheet40$] ) a "
Sql = " select v.cc,v.kk,w.ee from (select a.f1 as cc,count(*) as kk from " & Sql & " group by a.f1) v left join (select a.f1 as dd,count(a.aa) as ee from " & Sql & " where a.gg<0 and a.hh<0 and a.ll>0 or( a.ii<0 and a.jj<0 and a.ll>0 ) or( a.aa<0 and a.ff<0 and a.ll<0 ) or( a.gg<0 and a.hh<0 and a.ll<0 )or( a.aa<0 and a.ff<0 and a.ll=0 ) or( a.ii<0 and a.jj<0 and a.ll=0 )group by a.f1) w on v.cc=w.dd where v.cc is not null"
Set yy = X.Execute(Sql)
Sheet381.[1:888].Clear
Sheet381.[a1].CopyFromRecordset yy
Set yy = Nothing: Set X = Nothing
End Sub
这就是把sheet1-40工作表进行统计，把结果写在sheet381,但是不能同时统计41个以上的工作表，怎样办？