- 帖子
- 913
- 主題
- 150
- 精華
- 0
- 積分
- 1089
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- office 2019
- 閱讀權限
- 50
- 性別
- 女
- 註冊時間
- 2011-8-28
- 最後登錄
- 2023-7-19
 
|
2#
發表於 2017-8-20 00:00
| 只看該作者
您好,
我將程式修正為以下,
1.. VBA程式請放在VBA報表指令.xlsm 檔案中
2.. 將ERP_Data.xlsx的庫存.sheet複製到 盤點表.xlsx (先clear,再貼上值)
3.. 存檔時若已有盤點表的檔案存在時,不覆蓋,自動存為"盤點表_YYYYMMDD.HHMM
4.. 使系統不做任何詢問,不存檔直接關閉ERP_Data.xlsx
5.. copy 盤點表.sheet G、AC、AD、AH:AJ、AL、AM欄連同表頭 (儲存格格式,欄寬都要相同)到Label.sheet,從B欄開始依序貼上並加上篩選鍵
6.. A2一直到資料最底部，key入1.2.3等差數列,並且文字左右置中
7.. 複製一個Label.sheet>>Label (2)
以下的動作皆在Label (2).sheet
8.. Label (2) H欄篩選出=0的資料並刪除
9.. Label (2) E欄篩選出不等於1的資料並刪除
10.. I欄所有等於"V"的欄位,在下方增加二列(整列式)空白
11.. 並將I欄等於"V"的同一列的D欄儲存格內容,完全copy到新增空白列的第一列C欄位置,並且文字左右置中
12.. 儲存檔案,不關閉
 盤點表及標籤.part1.rar (500 KB)
盤點表及標籤.part2.rar (500 KB)
盤點表及標籤.part3.rar (427.43 KB)
有一部份的程式已經做好了，但...
1) 運作不正常,檔案無法自行開啟
2) 5~12無法用錄製巨集方式作業(因為資料不是固定模式的,常有增減),能夠幫忙寫後續程式嗎？- Sub 盤點表()
- Dim Msg As Boolean, W As Workbook, Wb As Workbook 'W As "來源檔" Wb As "目的檔"
- 'Boolean 型態的預設值為 False
- '*******Workbooks 開啟的活頁簿物件集合****
- For Each W In Workbooks
- If UCase(W.Name) = UCase("ERP_Data.xlsx") Then
- Msg = True '檔案已開啟
- Exit For
- End If
- Next
- '*****************************************來源檔
- If Msg = True Then '檔案已開啟
- Set W = Workbooks("ERP_Data.xlsx")
- Else '檔案尚未打開時
- Set W = Workbooks.Open("Q:\00_科毅\出貨文件連結\ERP_Data.xlsx")
- End If
- '*******Workbooks 開啟的活頁簿物件集合****目的檔
- If Msg = True Then '檔案已開啟
- Set Wb = Workbooks("盤點表.xlsx")
- Else '檔案尚未打開時
- Set Wb = Workbooks.Open("Q:\00_科毅\出貨文件連結\盤點表.xlsx")
- End If
- '*****************************************複製到新的活頁薄
- With W.Sheets("庫存")
- Set xRng = .UsedRange 'UsedRange->工作表所使用的全部範圍
- xRng.Copy '複製
- End With
- With Wb.Sheets("盤點表")
- .Range("A1").PasteSpecial xlPasteValues '選擇性貼上
- '.Range("A1").Paste '完全貼上(無效)
- Application.CutCopyMode = False '***不處於剪下或複製模式
- End With
- W.Close False '關閉檔案(不會問是否存檔)
- '*****************************************
- With Wb.Sheets("盤點表")
- ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2 '打開隱藏群組
- 'Wb.Save
- End With
- End Sub
|
|
