帖子: 146
主題: 41
精華: 0
積分: 229
點名: 289
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2024-11-22

2023年全勤獎章 2022虎年全勤獎章 2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章

1^# 跳轉到 » 正序看帖

打印

字體大小: tT

發表於 2021-1-4 09:04 | 只看該作者

[發問] 如何利用表單作出貨表

請教各位前輩,如何利用表單作出貨表,感恩.

出貨統計.jpg (149.53 KB)

出貨統計.rar (8.48 KB)

樓主熱帖

杜小平

singo1232001

　暱稱: 熱狗慶

中學生 Rank: 2

帖子: 354
主題: 5
精華: 0
積分: 387
點名: 0
作業系統: windows7
軟體版本: vba,vb,excel2007
閱讀權限: 20
性別: 男
註冊時間: 2017-1-8
最後登錄: 2024-8-2

論壇榮譽勳章論壇贊助勳章

9^#

發表於 2023-7-31 15:08 | 只看該作者

回復 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

TOP

hcm19522

大學生 Rank: 4

帖子: 1387
主題: 4
精華: 0
積分: 1397
點名: 0
作業系統: WIN
軟體版本: 2007
閱讀權限: 50
性別: 男
註冊時間: 2015-9-11
最後登錄: 2024-11-22

熱烈參與勳章

8^#

發表於 2023-7-31 12:24 | 只看該作者

固定十項往右建立 E19:H21=OFFSET($B$2,MOD($D19-1,10)+1,INT(($D19-1)/10)*5+COLUMN(A1))

google"EXCEL迷" blog 或google網址:https://hcm19522.blogspot.com/

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

帖子: 1446
主題: 40
精華: 0
積分: 1470
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 50
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2024-10-21

7^#

發表於 2023-7-26 14:20 | 只看該作者

謝謝論壇,謝謝各位前輩
後學趁工作空檔藉此帖練習陣列,學習方案如下,請各位前輩指教

資料表:

新增活頁簿所呈現的執行結果:

Option Explicit
Sub TEST()
Dim Arr, Brr, Crr(1 To 1000, 1 To 6), i&, j%, R&, n%, xA As Range
Arr = [B2:G2]: Arr(1, 6) = "金額"
Set xA = [B3:H12]
For n = 0 To [B2].CurrentRegion.Columns.Count \ 5 - 1
Brr = xA.Offset(0, 5 * n)
For i = 1 To UBound(Brr)
   If Val(Brr(i, 5)) = 0 Then GoTo i01
   R = R + 1
   For j = 1 To 5: Crr(R, j) = Brr(i, j): Next
i01: Next
Next
If R = 0 Then Exit Sub
With Workbooks.Add.Sheets(1)
.[A1].Resize(1, 6) = Arr
With .[A2].Resize(R + 1, 6)
   .Value = Crr
   .Columns(6) = "=D2*E2"
   .Cells(R + 1, 5).Resize(1, 2) = "=SUM(E2:E" & R + 1 & ")"
End With
.[A1].CurrentRegion.Borders.Value = 1
End With
Set xA = Nothing: Erase Arr, Brr, Crr
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

dou10801