- 帖子
- 234
- 主題
- 19
- 精華
- 0
- 積分
- 276
- 點名
- 0
- 作業系統
- Windows XP
- 軟體版本
- office 2003
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2013-1-7
- 最後登錄
- 2021-10-7
|
回復 13# PJChen
紅色字體為修改語法:
Sheet刪除由左向右會造成異常
For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '刪工作表
改為由右向左刪除
For i = 31 To mDay + 1 Step -1: xBK.Sheets(i & "").Delete: Next i
藍色字體為刪除
試試看!!
Sub EX()
Dim Path$, File$, i&, k&
Dim Lastday$, mDay%, xBK As Workbook, BK As Workbook
Dim myPath$, xFile$, m$, h$
Lastday = DateSerial(Year(Date), Month(Date) + 3, 0) '下下個月月底
mDay = Day(Lastday) '下個月天數
h = DateSerial(Year(Date), Month(Date) + 2, 1) '設定下個月1日
m = Format(h, "M月") '設定下個月份
Application.ScreenUpdating = False '關閉屏幕更新
Application.DisplayAlerts = False '一般提警示訊息關閉
Path = "D:\backup20060523\MDBView\麻辣學園\1.下個月理貨單_測試\檔案\" '來源資料夾
myPath = "D:\backup20060523\MDBView\麻辣學園\1.下個月理貨單_測試\2_暫\" '另存目的資料夾
File = Dir(Path & "*.xlsx") '來源檔名
Do While File <> ""
With Workbooks.Open(Path & File)
On Error Resume Next
Sheets("1").Activate
[A2] = Format(h, "M/D") '輸入指定日期,為下個月1日
ActiveWorkbook.Save '**存檔不關閉
End With
Set xBK = Workbooks.Open(Path & File) '開啟指定檔案
On Error Resume Next
' For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '刪工作表
For i = 31 To mDay + 1 Step -1: xBK.Sheets(i & "").Delete: Next i '刪工作表
On Error GoTo 0
For i = 1 To mDay
With xBK.Sheets(i & "")
.[A2] = .[A2].Value '值化
.[B1] = .[B1].Value '值化
End With
Next i
' For i = 1 To mDay '在工作表中循環
' With xBK.Sheets(i & "")
Sheets("1").Activate
For k = 1 To [U1] '將U1儲存格的值,作為變數存取次數,依序命名檔案名並存檔
[P1] = k '指定儲存格的值
ActiveWorkbook.SaveAs Filename:=myPath & [V2] & [G1] & " _" & m & ".xlsx" 'one by one 存檔k次
Next
ActiveWorkbook.Close True '存檔後關閉檔案
' End With
' Next i
File = Dir
Loop |
|
發表於 2020-2-10 11:49
| 
