- 帖子
- 354
- 主題
- 5
- 精華
- 0
- 積分
- 387
- 點名
- 0
- 作業系統
- windows7
- 軟體版本
- vba,vb,excel2007
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2017-1-8
- 最後登錄
- 2024-8-2
 
|
13#
發表於 2017-1-11 21:13
| 只看該作者
抱歉有點洗文章了
如果說 你的檔名 不要有order1的話
在saveas 那個位置,把 & 出檔號 給刪掉
下面這樣- Sub 自動新增日工作簿更新()
- Application.DisplayAlerts = False
- Application.ScreenUpdating = False
- 本檔名 = ActiveWorkbook.Name
- 本路徑 = ActiveWorkbook.Path
- 店名開頭索引 = "A店001"
- '***********************************************找出a店001位置***********************************
- For aaa = 1 To 20
- On Error Resume Next
- 店名欄位 = Sheets("Total").Rows(aaa).Find(What:=店名開頭索引, LookIn:=xlValues, SearchDirection:=xlNext).Column
- On Error GoTo 0
- Next
- For aaa = 1 To 店名欄位
- On Error Resume Next
- 店名列位 = Sheets("Total").Columns(aaa).Find(What:=店名開頭索引, LookIn:=xlValues, Lookat:=xlWhole, SearchDirection:=xlNext).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]
- 店家新增數量 = 0
- 店家新增店名 = "新增店名:"
- ''*************************其他資訊*************************
- '*************************流水號迴圈起始值*************************
- 流水 = 1
- '*************************流水號迴圈起始值*************************
- While 店名欄位 < 店名最後欄位 + 1
- If UCase(Workbooks(本檔名).Sheets("Total").Cells(7, 店名欄位)) = "K" Then '假如是k值 就不會新增
- 店名 = Workbooks(本檔名).Sheets("Total").Cells(店名列位, 店名欄位)
- 店家新增店名 = 店家新增店名 & vbCrLf & 店名
-
- 出檔號 = "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
- 店家新增數量 = 店家新增數量 + 1
- End If
- 流水 = 流水 + 1
- 店名欄位 = 店名欄位 + 1
- Wend
- MsgBox "共" & 店家新增數量 & "店家資料新增" & vbCrLf & 店家新增店名
- End Sub
|
|
