- 帖子
- 353
- 主題
- 5
- 精華
- 0
- 積分
- 386
- 點名
- 0
- 作業系統
- windows7
- 軟體版本
- vba,vb,excel2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2017-1-8
- 最後登錄
- 2024-4-30
 
|
回復 1# dou10801
Sub test()
Set s = Sheets("工作表1"): Set s2 = Sheets("工作表2"): s2.Cells.ClearContents
c = UBound(s.[b2].CurrentRegion.Value2, 2) / 5
ReDim ar(1 To c): s2.[H1:L1] = s.[b2:F2].Value
For i = 1 To c
s2.Cells(10 * i - 8, 8).Resize(10, 5) = s.Cells(3, 5 * i - 3).Resize(10, 5).Value
Next 'y=10x-8 <--二元一次聯立方程y=ax+b代入求-> y=5x-3
Set cn = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0; "
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0; "
cn.Open V & "Data Source=" & ThisWorkbook.FullName
q = "select 項次,[品 名],容量kg,售價,出貨數量,售價*出貨數量 as 金額 from[工作表2$H1:L] where 出貨數量 is not null"
Set rs = cn.Execute(q): s2.[A1:E1] = s.[b2:F2].Value: s2.[F1] = "金額": s2.[A2].CopyFromRecordset rs
q = "select sum(出貨數量) as 出貨數量 ,sum(金額) as 金額 from[工作表2$E1:F]"
Set rs = cn.Execute(q): r = s2.Cells(Rows.Count, "F").End(3).Row + 1
s2.Cells(r, "D") = "合計": s2.Cells(r, "E").CopyFromRecordset rs
End Sub |
|
發表於 2023-7-31 15:08
| 