|
以下代碼在一個工作表中是OK的,但是將各工作表放在一個文件夾下,將hdr=no;imex=1';data source=" & ThisWorkbook.FullName改為data source=" & ThisWorkbook.Path無法運行,因為對VBA不太懂,肯請大家協助
審單系統中是一個工作簿的資料,測試系統中是將各工作表另放一個工作簿
Sub test1()
Dim conn As Object, Sql$, S1 As Worksheet, S2 As Worksheet
Dim S3 As Worksheet, S4 As Worksheet, S5 As Worksheet, S6 As Worksheet, S7 As Worksheet, j&
t = Timer
Application.ScreenUpdating = False
Set S1 = Sheets("庫存")
Set S2 = Sheets("未結")
Set S3 = Sheets("未交")
Set S4 = Sheets("制令用料")
Set S5 = Sheets("原料展開")
Set S6 = Sheets("已請未購")
Set S7 = Sheets("缺料計算")
Set conn = CreateObject("adodb.connection")
conn.Open "provider=microsoft.jet.oledb.4.0;extended properties='excel 8.0;hdr=no;imex=1';data source=" & ThisWorkbook.FullName
S7.[A3:Z65536].clear
Sql = "Select * From (Select #" & S1.[B1] & "#,'','庫存',f6,f2,f3,0 from [庫存$A3:F" & S1.[a65536].End(xlUp).Row & "] " & _
"Union Select f3,f9,'未交',f11,f5,f6,0 From [未交$A3:k" & S3.[a65536].End(xlUp).Row & "] " & _
"Union Select f1,f2,'原料展開',f7,f4,f6,0 From [原料展開$A3:g" & S5.[a65536].End(xlUp).Row & "] " & _
"Union Select f3,f10,'未結',f4,f5,f8,0 From [未結$A3:K" & S2.[a65536].End(xlUp).Row & "] " & _
"Union Select f2,f3,'已請未購',f4,f7,f5,0 From [已請未購$A3:K" & S6.[a65536].End(xlUp).Row & "] " & _
"Union Select f1,f2,'制令用料',f10,f3,0,f5 from [制令用料$A3:J" & S4.[a65536].End(xlUp).Row & "])"
Sheet9.[A3].CopyFromRecordset conn.Execute(Sql)
Sql = "Select * From [缺料計算$A3:H" & S7.[a65536].End(xlUp).Row & "] order by f1,f4,f6 Desc" '以入库数-->日期-->料号的顺序排列
Sheet9.[A3].CopyFromRecordset conn.Execute(Sql)
Call tt
conn.Close
Set conn = Nothing
Application.ScreenUpdating = True
Columns("H:H").Select
Selection.NumberFormatLocal = "0_ ;[红色]-0 "
Range("H31893").Select
MsgBox "汇总库存计划完成" & vbCr & "共用時" & Format((Timer - t), "0.00") & "秒"
End Sub
该贴已经同步到 yancjm的微博 |
|