返回列表 上一主題 發帖

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

dou10801

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2021-1-4 09:04 | 只看該作者

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

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

出貨統計.jpg (149.53 KB)

出貨統計.jpg

出貨統計.rar (8.48 KB)

收藏 分享
杜小平

hcm19522

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

熱烈參與勳章
2#
發表於 2021-1-4 10:06 | 只看該作者
https://blog.xuite.net/hcm19522/twblog/589540468
google"EXCEL迷"  blog  或google網址:https://hcm19522.blogspot.com/

TOP

ikboy

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

2016猴年全勤獎章
3#
發表於 2021-1-4 11:17 | 只看該作者
  1. Sub zz()
  2. Dim a, Title, b(), c&, n&, k&, r&, t&
  3. Title = [b2:f2].Value
  4. c = UBound(Title, 2)
  5. a = [b2].CurrentRegion.Value
  6. t = UBound(a, 2) / c - 1
  7. ReDim b(1 To UBound(a) * (t + 1), 1 To c + 1)
  8. For n = 0 To t
  9.     k = n * c + c
  10.     For i = 2 To UBound(a)
  11.         If a(i, k) Then
  12.             r = r + 1
  13.             For j = 1 To c
  14.                 b(r, j) = a(i, k - c + j)
  15.             Next
  16.             b(r, c + 1) = b(r, 4) * b(r, 5)
  17.         End If
  18.     Next
  19. Next
  20. Workbooks.Add 1
  21. [a1].Resize(1, c) = Title
  22. Cells(1, c + 1) = "Amount"
  23. [a2].Resize(r, c + 1) = b
  24. [a1].CurrentRegion.Borders.Value = 1
  25. End Sub
複製代碼

TOP

dou10801

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章
4#
發表於 2021-1-4 13:26 | 只看該作者
回復 3# ikboy 感謝ikboy,程式可用其他自行修飾,因功力不足,是否能將程式功能註解,讓小弟學習.
杜小平

TOP

ikboy

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

2016猴年全勤獎章
5#
發表於 2021-1-4 16:44 | 只看該作者
回復 4# dou10801
  1. Sub zz()
  2. Dim a, Title, b(), c&, n&, k&, r&, t&
  3. Title = [b2:f2].Value   '取標題
  4. c = UBound(Title, 2)    '取標題長度
  5. a = [b2].CurrentRegion.Value '取表1的資料放入 a Array
  6. t = UBound(a, 2) / c - 1    '計算表1中標題的重複次數 以 0 開始至 t, 為以下第一循環作好計算 ,請看 @_@
  7. ReDim b(1 To UBound(a) * (t + 1), 1 To c + 1)   '建立一個較大的 b Array
  8. For n = 0 To t  '@_@
  9.     k = n * c + c   '計算 k 的值, 即出貨數量在Title中的位置
  10.     For i = 2 To UBound(a)  '由 a 的第2行循環
  11.         If a(i, k) Then '行列對應有出貨數量, 進行以下程序
  12.             r = r + 1   '建立新行數給 b Array
  13.             For j = 1 To c  '循環標題長度
  14.                 b(r, j) = a(i, k - c + j)   '取 a Array 中相對行列的資料給 b Array
  15.             Next            '循環
  16.             b(r, c + 1) = b(r, 4) * b(r, 5) '計算金額
  17.         End If
  18.     Next    '循環
  19. Next    '循環
  20. Workbooks.Add 1 '新建工作簿
  21. [a1].Resize(1, c) = Title   '寫入標題
  22. Cells(1, c + 1) = "Amount" '寫入新標題
  23. [a2].Resize(r, c + 1) = b   '將 b Array 寫入
  24. [a1].CurrentRegion.Borders.Value = 1    '畫上格線
  25. End Sub
複製代碼

TOP

dou10801

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

2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章論壇榮譽勳章論壇贊助勳章
6#
發表於 2021-1-5 07:57 | 只看該作者
回復 5# ikboy ikboy大大,感恩.
杜小平

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

hcm19522

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

熱烈參與勳章
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

        靜思自在 : 愛不是要求對方，而是要由自身的付出。
返回列表 上一主題