帖子: 150
主題: 43
精華: 0
積分: 235
點名: 174
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2025-7-11

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

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

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

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

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

出貨統計.jpg (149.53 KB)

出貨統計.rar (8.48 KB)

樓主熱帖

杜小平

hcm19522

大學生 Rank: 4

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

熱烈參與勳章

2^#

發表於 2021-1-4 10:06 | 只看該作者

https://blog.xuite.net/hcm19522/twblog/589540468

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

TOP

ikboy

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 0
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2025-3-24

2016猴年全勤獎章

3^#

發表於 2021-1-4 11:17 | 只看該作者

Sub zz()
Dim a, Title, b(), c&, n&, k&, r&, t&
Title = [b2:f2].Value
c = UBound(Title, 2)
a = [b2].CurrentRegion.Value
t = UBound(a, 2) / c - 1
ReDim b(1 To UBound(a) * (t + 1), 1 To c + 1)
For n = 0 To t
k = n * c + c
For i = 2 To UBound(a)
If a(i, k) Then
r = r + 1
For j = 1 To c
b(r, j) = a(i, k - c + j)
Next
b(r, c + 1) = b(r, 4) * b(r, 5)
End If
Next
Next
Workbooks.Add 1
[a1].Resize(1, c) = Title
Cells(1, c + 1) = "Amount"
[a2].Resize(r, c + 1) = b
[a1].CurrentRegion.Borders.Value = 1
End Sub

複製代碼

TOP

dou10801

中學生 Rank: 2

帖子: 150
主題: 43
精華: 0
積分: 235
點名: 174
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2025-7-11

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

4^#

發表於 2021-1-4 13:26 | 只看該作者

回復 3# ikboy 感謝ikboy,程式可用其他自行修飾,因功力不足,是否能將程式功能註解,讓小弟學習.

杜小平

TOP

ikboy

中學生 Rank: 2

帖子: 262
主題: 8
精華: 0
積分: 280
點名: 0
作業系統: xp
軟體版本: Office 2007
閱讀權限: 20
性別: 男
來自: HK
註冊時間: 2015-8-11
最後登錄: 2025-3-24

2016猴年全勤獎章

5^#

發表於 2021-1-4 16:44 | 只看該作者

回復 4# dou10801

Sub zz()
Dim a, Title, b(), c&, n&, k&, r&, t&
Title = [b2:f2].Value '取標題
c = UBound(Title, 2) '取標題長度
a = [b2].CurrentRegion.Value '取表1的資料放入 a Array
t = UBound(a, 2) / c - 1 '計算表1中標題的重複次數以 0 開始至 t, 為以下第一循環作好計算 ,請看 @_@
ReDim b(1 To UBound(a) * (t + 1), 1 To c + 1) '建立一個較大的 b Array
For n = 0 To t '@_@
k = n * c + c '計算 k 的值, 即出貨數量在Title中的位置
For i = 2 To UBound(a) '由 a 的第2行循環
If a(i, k) Then '行列對應有出貨數量, 進行以下程序
r = r + 1 '建立新行數給 b Array
For j = 1 To c '循環標題長度
b(r, j) = a(i, k - c + j) '取 a Array 中相對行列的資料給 b Array
Next '循環
b(r, c + 1) = b(r, 4) * b(r, 5) '計算金額
End If
Next '循環
Next '循環
Workbooks.Add 1 '新建工作簿
[a1].Resize(1, c) = Title '寫入標題
Cells(1, c + 1) = "Amount" '寫入新標題
[a2].Resize(r, c + 1) = b '將 b Array 寫入
[a1].CurrentRegion.Borders.Value = 1 '畫上格線
End Sub

複製代碼

TOP

dou10801

中學生 Rank: 2

帖子: 150
主題: 43
精華: 0
積分: 235
點名: 174
作業系統: WIN10
軟體版本: 2010
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2011-6-21
最後登錄: 2025-7-11

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

6^#

發表於 2021-1-5 07:57 | 只看該作者

回復 5# ikboy ikboy大大,感恩.

杜小平

TOP

Andy2483

　暱稱: 厚臉皮的學生

大學生 Rank: 4

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

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

hcm19522

大學生 Rank: 4

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

熱烈參與勳章

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

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