12
返回列表 上一主題 發帖

[發問] 請問要如何簡化/更改VBA, 完成往後的Order呢?

boomf2

帖子
17 
主題
7 
精華
0 
積分
24 
點名
0  
作業系統
windwo10 
軟體版本
excel2013 
閱讀權限
10 
註冊時間
2017-1-7 
最後登錄
2023-2-18 

論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2017-1-9 01:31 | 只看該作者

[發問] 請問要如何簡化/更改VBA, 完成往後的Order呢?

如何
本帖最後由 boomf2 於 2017-1-9 01:34 編輯

我做的 按鈕1 很笨
只能成功在新的SHEET產生了 特定ORDER 1 - Sheet (A店001).

請問要如何簡化/更改VBA, 完成往後的15張 Order呢?

請高指導一下要怎麼寫vba...:'(

Order.rar (7.16 KB)
收藏 分享

boomf2

帖子
17 
主題
7 
精華
0 
積分
24 
點名
0  
作業系統
windwo10 
軟體版本
excel2013 
閱讀權限
10 
註冊時間
2017-1-7 
最後登錄
2023-2-18 

論壇贊助勳章
2#
發表於 2017-1-9 08:24 | 只看該作者
我做的 按鈕1 很笨
只能成功在新的SHEET產生了 特定ORDER 1 - Sheet (A店001).

請問要如何簡化/更改VBA ...
boomf2 發表於 2017-1-9 01:31



    Order更新1.rar (30.99 KB)

原來我放錯附件了...這個才對的

我做的 按鈕1
只能成功在新的SHEET產生了 特定ORDER 1 - Sheet (A店001).

請問要如何簡化/更改VBA, 完成往後的15張 Order呢?
其實我想把全部15個都放在新WORKBOOK, 分成15張SHEET的.

請高指導一下要怎麼寫vba...:'(

TOP

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

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

論壇榮譽勳章論壇贊助勳章
3#
發表於 2017-1-9 10:17 | 只看該作者
回復 2# boomf2


    剛發現你有兩個 A店002 請問想如何區別

   因為檔案名稱不能有重複

TOP

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

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

論壇榮譽勳章論壇贊助勳章
4#
發表於 2017-1-9 10:56 | 只看該作者
回復 2# boomf2
  1.     Sub 自動新增日工作簿更新()

  3. 本檔名 = ActiveWorkbook.Name
  4. 本路徑 = ActiveWorkbook.Path


  7. '***********************************************找出a店001位置***********************************
  8. For aaa = 1 To 20
  9. On Error Resume Next
  10. 店名欄位 = Sheets("Total").Rows(aaa).Find(What:="A店001", LookIn:=xlValues, SearchDirection:=xlPrevious).Column
  11. On Error GoTo 0
  12. Next

  14. For aaa = 1 To 店名欄位
  15. On Error Resume Next
  16. 店名列位 = Sheets("Total").Columns(aaa).Find(What:="A店001", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Row
  17. On Error GoTo 0
  18. Next
  19. '***********************************************找出a店001位置***********************************




  24. '***********************************************找出最後一間店位置***********************************
  25. 店名最後欄位 = Sheets("Total").Rows(店名列位).Find(What:="*", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Column
  26. '***********************************************找出最後一間店位置***********************************




  31. '***********************************************找出產品數量***********************************
  32. 產品code欄 = Sheets("Total").Rows(店名列位).Find(What:="產品CODE", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Column

  34. 產品code列 = Sheets("Total").Columns(產品code欄).Find(What:="*", LookIn:=xlValues, SearchDirection:=xlPrevious).Row

  36. 產品總數 = 產品code列 - 店名列位
  37. '***********************************************找出產品數量***********************************


  40. '***********************************************讓之後迴圈用***********************************
  41. 產品起始列定位 = 店名列位 + 1
  42. 產品結束列定位 = 產品code列
  43. '***********************************************讓之後迴圈用***********************************

  45. ''*************************其他資訊*************************
  46. 日期暫存 = Workbooks(本檔名).Sheets("Total").[G1]

  48. ''*************************其他資訊*************************





  54. '*************************流水號迴圈起始值*************************
  55. 流水 = 1
  56. '*************************流水號迴圈起始值*************************

  58. While 店名欄位 < 店名最後欄位 + 1

  60. 店名 = Workbooks(本檔名).Sheets("Total").Cells(店名列位, 店名欄位)


  63. 出檔號 = "order" & 流水
  64. Set nX = Workbooks.Add


  67. Application.DisplayAlerts = False

  69. ActiveWorkbook.Sheets(3).Delete
  70. ActiveWorkbook.Sheets(2).Delete
  71. ActiveWorkbook.Sheets(1).Name = 店名


  74. 產品運算列 = 產品起始列定位
  75. 產品停算列 = 產品結束列定位

  77.     orderrow = 1
  78.     While 產品運算列 < 產品停算列 + 1
  79.     If Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 店名欄位) <> "" Then
  80.    
  81.             ActiveWorkbook.Sheets(1).Cells(orderrow, 1) = "DK"
  82.             ActiveWorkbook.Sheets(1).Cells(orderrow, 3) = 日期暫存
  83.             ActiveWorkbook.Sheets(1).Cells(orderrow, 4) = "DN"
  84.             ActiveWorkbook.Sheets(1).Cells(orderrow, 5) = "B99"
  85.             ActiveWorkbook.Sheets(1).Cells(orderrow, 6) = "店名"
  86.             ActiveWorkbook.Sheets(1).Cells(orderrow, 7) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 產品code欄).Value
  87.             ActiveWorkbook.Sheets(1).Cells(orderrow, 8) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 產品code欄 + 3).Value
  88.             ActiveWorkbook.Sheets(1).Cells(orderrow, 9) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 店名欄位)
  89.             orderrow = orderrow + 1
  90.     End If
  91.    
  92.    
  93.     產品運算列 = 產品運算列 + 1
  94.     Wend

  96. nX.SaveAs ThisWorkbook.Path & "/" & 出檔號 & 店名
  97. nX.Close

  99. 流水 = 流水 + 1
  100. 店名欄位 = 店名欄位 + 1
  101. Wend


  104. End Sub
複製代碼

TOP

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

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

論壇榮譽勳章論壇贊助勳章
5#
發表於 2017-1-9 11:38 | 只看該作者
店名列位 = Sheets("Total").Columns(aaa).Find(What:="A店001", LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlPrevious).Row

Look at:=xlwhole
的用法是要完全比對，我有一行並沒有打到
但想了一下打了完全比對好像也沒用

因為我想到妳的店名有可能重複
那一開始的定位 或許你要找一下其他方式
或者用selection.range的方式
儲存成變數，選好起始欄位
在抓欄列值
再傳給後面的程式碼使用

TOP

准提部林

帖子
2833 
主題
10 
精華
0 
積分
2889 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-17 
6#
發表於 2017-1-9 21:07 | 只看該作者
  1. Sub TEST()
  2. Dim R%, C&, xDate$, Arr, Brr, Crr, i&, j&, N&
  3. Dim xB As Workbook, xS As Worksheet, SS%
  4. R = Cells(Rows.Count, "D").End(xlUp).Row - 9 '資料列數(含標題列)
  5. C = Cells(10, Columns.Count).End(xlToLeft).Column - 15 '(Order欄數)
  6. If R <= 0 Or C <= 0 Then Exit Sub
  7. xDate = [G1] '日期
  8. Arr = [D10].Resize(R) '產品CODE
  9. Brr = [P10].Resize(R, C) 'Order資料區
  10. Set xB = Workbooks.Add '開新檔案
  11. For i = C To 1 Step -1
  12.     If Brr(1, i) = "" Then GoTo 101
  13.     Set xS = xB.Sheets.Add: xS.Name = Brr(1, i) '新增工作表
  14.     xS.[C:C].ColumnWidth = 11 '日期欄寬
  15.     N = 0: SS = SS + 1 '新增工作表累計張數
  16.     For j = 2 To R
  17.         If Brr(j, i) <> "" Then
  18.            N = N + 1
  19.            xS.Cells(N, 1).Resize(1, 9) = Array("DK", "", "'" & xDate, "DN", "B99", Brr(1, i), Arr(j, 1), "", Brr(j, i))
  20.         End If
  21.     Next
  22. 101: Next i

  24. Application.DisplayAlerts = False
  25. If SS > 0 Then
  26.    For i = xB.Sheets.Count To SS + 1 Step -1
  27.        xB.Sheets(i).Delete '刪除新檔案預設空白工作表
  28.    Next
  29. End If
  30. xB.SaveAs Filename:=ThisWorkbook.Path & "\明細表_" & xDate & ".xls", CreateBackup:=False '另存新檔
  31. End Sub
複製代碼
Xl0000061.rar (16.85 KB)

TOP

boomf2

帖子
17 
主題
7 
精華
0 
積分
24 
點名
0  
作業系統
windwo10 
軟體版本
excel2013 
閱讀權限
10 
註冊時間
2017-1-7 
最後登錄
2023-2-18 

論壇贊助勳章
7#
發表於 2017-1-9 23:28 | 只看該作者
回復 5# singo1232001


   不好意思,我有製作範本時,不小心重覆了.
是不會重覆的.

我正在慢慢了解詰些CODE...需要點時間...

TOP

boomf2

帖子
17 
主題
7 
精華
0 
積分
24 
點名
0  
作業系統
windwo10 
軟體版本
excel2013 
閱讀權限
10 
註冊時間
2017-1-7 
最後登錄
2023-2-18 

論壇贊助勳章
8#
發表於 2017-1-11 07:32 | 只看該作者
回復 6# 准提部林

謝謝版主 准提部林.
我昨晚沒怎睡試了一下作一些改動......可惜我不成功..

你可以再幫我看看嗎?

Xl0000061B.rar (120.45 KB)

我在X10000061B.xls 裡
黃色的一行:

想在VBA加入= K 的話, 才新增到new workbook new sheet
=fff 的話, 我打算之後再
新增橙色是店鋪名:
我想把它放在明細表裡 的 "K" - 這個我試了很久…但不成功.


在明細表裡:

想把原本"K"裡的Brr(1, i) 放在 "J"
已改成Resize(1,10), 新增了一個Brr(1, i) 到最後.
xS.Cells(N, 1).Resize(1, 10) = Array("DK", "", "'" & xDate, "DN", "B99", Brr(1, i), Arr(j, 1), "", Brr(j, i), Brr(1, i))

最後我想把 新增出來的 明細表裡的Sheet, 再SAVE AS 成單獨FILE...

我試過Personal VBA project book 加入分割SHEET成XLS 的SUB, 可是...只分拆了一個出來...怪怪的.
請指教一下...謝謝

TOP

boomf2

帖子
17 
主題
7 
精華
0 
積分
24 
點名
0  
作業系統
windwo10 
軟體版本
excel2013 
閱讀權限
10 
註冊時間
2017-1-7 
最後登錄
2023-2-18 

論壇贊助勳章
9#
發表於 2017-1-11 07:38 | 只看該作者
想在VBA加入= K 的話, 才新增到new workbook new sheet
=fff 的話, 先不作輸出. 我打算之後再做一些CSV格式.

TOP

准提部林

帖子
2833 
主題
10 
精華
0 
積分
2889 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-17 
10#
發表於 2017-1-11 10:30 | 只看該作者
回復 9# boomf2

Xl0000061B_V1.rar (123.47 KB)

最近忙, 若有其它補充或修改, 請其他大大幫忙!

TOP

        靜思自在 : 有多少力量就做多少事，不要心存等待，等待才會落空。
12
返回列表 上一主題