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 

論壇贊助勳章
14#
發表於 2017-1-18 11:33 | 只看該作者
回復 10# 准提部林


ThanksBros

我已經再加進了很多東東
這次學會了很快的方法去處理和控制資料範圍!
,謝謝指導=] !

TOP

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

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

論壇榮譽勳章論壇贊助勳章
13#
發表於 2017-1-11 21:13 | 只看該作者
抱歉有點洗文章了

如果說 你的檔名 不要有order1的話

在saveas 那個位置,把   & 出檔號    給刪掉

下面這樣
  1. Sub 自動新增日工作簿更新()


  4. Application.DisplayAlerts = False
  5. Application.ScreenUpdating = False
  6. 本檔名 = ActiveWorkbook.Name
  7. 本路徑 = ActiveWorkbook.Path

  9. 店名開頭索引 = "A店001"

  11. '***********************************************找出a店001位置***********************************
  12. For aaa = 1 To 20
  13. On Error Resume Next
  14. 店名欄位 = Sheets("Total").Rows(aaa).Find(What:=店名開頭索引, LookIn:=xlValues, SearchDirection:=xlNext).Column
  15. On Error GoTo 0
  16. Next

  18. For aaa = 1 To 店名欄位
  19. On Error Resume Next
  20. 店名列位 = Sheets("Total").Columns(aaa).Find(What:=店名開頭索引, LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlNext).Row
  21. On Error GoTo 0
  22. Next
  23. '***********************************************找出a店001位置***********************************




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




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

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

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


  44. '***********************************************讓之後迴圈用***********************************
  45. 產品起始列定位 = 店名列位 + 1
  46. 產品結束列定位 = 產品code列
  47. '***********************************************讓之後迴圈用***********************************

  49. ''*************************其他資訊*************************
  50. 日期暫存 = Workbooks(本檔名).Sheets("Total").[G1]
  51. 店家新增數量 = 0
  52. 店家新增店名 = "新增店名:"
  53. ''*************************其他資訊*************************





  59. '*************************流水號迴圈起始值*************************
  60. 流水 = 1
  61. '*************************流水號迴圈起始值*************************

  63. While 店名欄位 < 店名最後欄位 + 1
  64. If UCase(Workbooks(本檔名).Sheets("Total").Cells(7, 店名欄位)) = "K" Then    '假如是k值 就不會新增


  67.     店名 = Workbooks(本檔名).Sheets("Total").Cells(店名列位, 店名欄位)
  68.     店家新增店名 = 店家新增店名 & vbCrLf & 店名
  69.    
  70.     出檔號 = "order" & 流水
  71.     Set nX = Workbooks.Add


  74.     Application.DisplayAlerts = False
  75.    
  76.     If ActiveWorkbook.Sheets.Count = 3 Then
  77.     ActiveWorkbook.Sheets(3).Delete
  78.     End If
  79.     If ActiveWorkbook.Sheets.Count = 2 Then
  80.     ActiveWorkbook.Sheets(2).Delete
  81.     End If
  82.     ActiveWorkbook.Sheets(1).Name = 店名


  85.     產品運算列 = 產品起始列定位
  86.     產品停算列 = 產品結束列定位

  88.     orderrow = 1
  89.     While 產品運算列 < 產品停算列 + 1
  90.         If Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 店名欄位) <> "" Then
  91.    
  92.             ActiveWorkbook.Sheets(1).Cells(orderrow, 1) = "DK"
  93.             ActiveWorkbook.Sheets(1).Cells(orderrow, 3) = 日期暫存
  94.             ActiveWorkbook.Sheets(1).Cells(orderrow, 4) = "DN"
  95.             ActiveWorkbook.Sheets(1).Cells(orderrow, 5) = "B99"
  96.             ActiveWorkbook.Sheets(1).Cells(orderrow, 6) = "店名"
  97.             ActiveWorkbook.Sheets(1).Cells(orderrow, 7) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 產品code欄).Value
  98.             ActiveWorkbook.Sheets(1).Cells(orderrow, 8) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 產品code欄 + 3).Value
  99.             ActiveWorkbook.Sheets(1).Cells(orderrow, 9) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 店名欄位)
  100.             orderrow = orderrow + 1
  101.         End If
  102.    
  103.    
  104.     產品運算列 = 產品運算列 + 1
  105.     Wend

  107.     nX.SaveAs ThisWorkbook.Path & "/" & 店名
  108.     nX.Close
  109.     店家新增數量 = 店家新增數量 + 1
  110. End If

  112. 流水 = 流水 + 1
  113. 店名欄位 = 店名欄位 + 1
  114. Wend


  117. MsgBox "共" & 店家新增數量 & "店家資料新增" & vbCrLf & 店家新增店名
  118. End Sub
複製代碼

TOP

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

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

論壇榮譽勳章論壇贊助勳章
12#
發表於 2017-1-11 21:07 | 只看該作者
  1. Sub 自動新增日工作簿更新()


  4. Application.DisplayAlerts = False
  5. Application.ScreenUpdating = False
  6. 本檔名 = ActiveWorkbook.Name
  7. 本路徑 = ActiveWorkbook.Path

  9. 店名開頭索引 = "A店001"

  11. '***********************************************找出a店001位置***********************************
  12. For aaa = 1 To 20
  13. On Error Resume Next
  14. 店名欄位 = Sheets("Total").Rows(aaa).Find(What:=店名開頭索引, LookIn:=xlValues, SearchDirection:=xlNext).Column
  15. On Error GoTo 0
  16. Next

  18. For aaa = 1 To 店名欄位
  19. On Error Resume Next
  20. 店名列位 = Sheets("Total").Columns(aaa).Find(What:=店名開頭索引, LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlNext).Row
  21. On Error GoTo 0
  22. Next
  23. '***********************************************找出a店001位置***********************************




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




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

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

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


  44. '***********************************************讓之後迴圈用***********************************
  45. 產品起始列定位 = 店名列位 + 1
  46. 產品結束列定位 = 產品code列
  47. '***********************************************讓之後迴圈用***********************************

  49. ''*************************其他資訊*************************
  50. 日期暫存 = Workbooks(本檔名).Sheets("Total").[G1]
  51. 店家新增數量 = 0
  52. 店家新增店名 = "新增店名:"
  53. ''*************************其他資訊*************************





  59. '*************************流水號迴圈起始值*************************
  60. 流水 = 1
  61. '*************************流水號迴圈起始值*************************

  63. While 店名欄位 < 店名最後欄位 + 1
  64. If UCase(Workbooks(本檔名).Sheets("Total").Cells(7, 店名欄位)) = "K" Then    '假如是k值 就不會新增


  67.     店名 = Workbooks(本檔名).Sheets("Total").Cells(店名列位, 店名欄位)
  68.     店家新增店名 = 店家新增店名 & vbCrLf & 店名
  69.    
  70.     出檔號 = "order" & 流水
  71.     Set nX = Workbooks.Add


  74.     Application.DisplayAlerts = False
  75.    
  76.     If ActiveWorkbook.Sheets.Count = 3 Then
  77.     ActiveWorkbook.Sheets(3).Delete
  78.     End If
  79.     If ActiveWorkbook.Sheets.Count = 2 Then
  80.     ActiveWorkbook.Sheets(2).Delete
  81.     End If
  82.     ActiveWorkbook.Sheets(1).Name = 店名


  85.     產品運算列 = 產品起始列定位
  86.     產品停算列 = 產品結束列定位

  88.     orderrow = 1
  89.     While 產品運算列 < 產品停算列 + 1
  90.         If Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 店名欄位) <> "" Then
  91.    
  92.             ActiveWorkbook.Sheets(1).Cells(orderrow, 1) = "DK"
  93.             ActiveWorkbook.Sheets(1).Cells(orderrow, 3) = 日期暫存
  94.             ActiveWorkbook.Sheets(1).Cells(orderrow, 4) = "DN"
  95.             ActiveWorkbook.Sheets(1).Cells(orderrow, 5) = "B99"
  96.             ActiveWorkbook.Sheets(1).Cells(orderrow, 6) = "店名"
  97.             ActiveWorkbook.Sheets(1).Cells(orderrow, 7) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 產品code欄).Value
  98.             ActiveWorkbook.Sheets(1).Cells(orderrow, 8) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 產品code欄 + 3).Value
  99.             ActiveWorkbook.Sheets(1).Cells(orderrow, 9) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 店名欄位)
  100.             orderrow = orderrow + 1
  101.         End If
  102.    
  103.    
  104.     產品運算列 = 產品運算列 + 1
  105.     Wend

  107.     nX.SaveAs ThisWorkbook.Path & "/" & 出檔號 & 店名
  108.     nX.Close
  109.     店家新增數量 = 店家新增數量 + 1
  110. End If

  112. 流水 = 流水 + 1
  113. 店名欄位 = 店名欄位 + 1
  114. Wend


  117. MsgBox "共" & 店家新增數量 & "店家資料新增" & vbCrLf & 店家新增店名
  118. End Sub
複製代碼
'修正刪除工作表
'新增判斷K值
'反過來搜尋起始點"A店001"的位置
'新增建立筆數與店家名稱

TOP

singo1232001
　暱稱: 熱狗慶

中學生Rank: 2

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

論壇榮譽勳章論壇贊助勳章
11#
發表於 2017-1-11 19:31 | 只看該作者
回復 8# boomf2


        Sub 自動新增日工作簿更新()

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


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

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




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




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

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

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


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

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

''*************************其他資訊*************************





'*************************流水號迴圈起始值*************************
流水 = 1
'*************************流水號迴圈起始值*************************

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

If Workbooks(本檔名).Sheets("Total").Cells(7, 店名欄位) = "K" Then '假如是K就做
   
    店名 = Workbooks(本檔名).Sheets("Total").Cells(店名列位, 店名欄位)


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


    Application.DisplayAlerts = False
   
    If ActiveWorkbook.Sheets.Count = 3 Then
    ActiveWorkbook.Sheets(3).Delete
    End If
    If ActiveWorkbook.Sheets.Count = 2 Then
    ActiveWorkbook.Sheets(2).Delete
    End If
    ActiveWorkbook.Sheets(1).Name = 店名
   

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

        orderrow = 1
        While 產品運算列 < 產品停算列 + 1
          If Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 店名欄位) <> "" Then
   
              ActiveWorkbook.Sheets(1).Cells(orderrow, 1) = "DK"
              ActiveWorkbook.Sheets(1).Cells(orderrow, 3) = 日期暫存
              ActiveWorkbook.Sheets(1).Cells(orderrow, 4) = "DN"
               ActiveWorkbook.Sheets(1).Cells(orderrow, 5) = "B99"
              ActiveWorkbook.Sheets(1).Cells(orderrow, 6) = "店名"
               ActiveWorkbook.Sheets(1).Cells(orderrow, 7) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 產品code欄).Value
              ActiveWorkbook.Sheets(1).Cells(orderrow, 8) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 產品code欄 + 3).Value
              ActiveWorkbook.Sheets(1).Cells(orderrow, 9) = Workbooks(本檔名).Sheets("Total").Cells(產品運算列, 店名欄位)
               orderrow = orderrow + 1
         End If
   
   
     產品運算列 = 產品運算列 + 1
        Wend

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



End If  '假如是K 結束

流水 = 流水 + 1
店名欄位 = 店名欄位 + 1
Wend


End Sub


K值才會做
修正工作表數量刪除

TOP

准提部林

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

Xl0000061B_V1.rar (123.47 KB)

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

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

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 

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


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

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

TOP

准提部林

帖子
2834 
主題
10 
精華
0 
積分
2890 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2024-11-23 
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

        靜思自在 : 脾氣嘴巴不好，心地再好也不能算是好人。
12
返回列表 上一主題