12
返回列表 上一主題 發帖

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

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

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 

論壇榮譽勳章論壇贊助勳章
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

boomf2

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

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


ThanksBros

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

TOP

        靜思自在 : 謊言像一朵盛開的鮮花，外表美麗，生命短暫。
12
返回列表 上一主題