123
返回列表 上一主題 發帖

[發問] 下個月新檔

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2019-11-26 00:04 | 只看該作者

[發問] 下個月新檔

Dear,
我有一個程式,是為了可以自動run下個月的新檔案而設
最近新增一段程式,結果變成一直循環貼資料
若把有問題的這一段註解,則程式就沒有問題
請 大大們幫忙看下程式...感謝

VB作業內容:
在資料夾中打開檔案群
輸入下個月1日的日期,存檔不關閉
值化日期儲存格
刪除大於月底日的工作表
另存目的資料夾
依P1的工作表名稱數量,依序命名檔案名並分別存檔
目的工作表打開,值化每個工作表頭的名稱並clear原公式
依P1的工作表名稱數量,依序命名檔案名並分別存檔
目的工作表打開,值化每個工作表頭的名稱並clear原公式


*******************我希望達到的新增加功能(有問題,會一直循環貼資料)
1. 自動偵測商品.xlsx是否已開啟,已開則忽略,未開則打開
2. 自動偵測商品.xlsx的列數(商品.xlsx會有最新的產品資料,而且列數會有增加及減少的可能性)
3. 把資料的"值"(不要格式)貼到理貨單的第一個工作表"出貨數" (有２個測試檔：飛比_暖暖.湖口.xlsx／BF-QOO.xlsx,正式的作業還會有更多的檔案）

因為我不會寫這段程式,所以是用手動的做法：
進程式中修改,指定A19選取一整列,預設為複製一列,如要刪除一列,則要
這表示要先知道出貨數與商品欄的列數有多少不同
然後程式會將Workbooks("商品.xlsx").Sheets("飛比商品").Range("商品欄")的資料自動貼上
目前預設是插入一列後,貼上商品資料
若是資料不需變動時,要註解掉,就不會執行

用寫的可能無法很詳細,我已把有問題這一段註解了,先run下程式, 可能就明白我在說什麼！
1.下個月理貨單_測試.rar (226.82 KB)
收藏 分享

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
22#
發表於 2020-2-11 16:10 | 只看該作者
回復 21# jcchiang

好的,測試成功了
感謝

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
21#
發表於 2020-2-11 12:57 | 只看該作者
回復 20# PJChen
Sheets("1").Range("A2")的日期(2020/4/1),抓月底日
Lastday = DateSerial(Year(BK.Sheets("1").Range("A2")), Month(BK.Sheets("1").Range("A2")), 0) '月底日
這樣Lastday是2020/3/31
mDay = Day(Lastday)是31
改成Lastday = DateSerial(Year(BK.Sheets("1").Range("A2")), Month(BK.Sheets("1").Range("A2")) +1, 0) '月底日
Lastday是2020/4/30
mDay = Day(Lastday)是30

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
20#
發表於 2020-2-10 18:17 | 只看該作者
本帖最後由 PJChen 於 2020-2-10 18:18 編輯

回復 15# 准提部林
回復 19# jcchiang

前一個程式結束後,我還要作後續的檔案處理,我延用之前的語法,一樣是測試4月份,
以工作表中的Sheets("1").Range("A2")的日期(2020/4/1),抓月底日
改為這樣,但為什麼紅色部份,仍無法執行?
Lastday = DateSerial(Year(BK.Sheets("1").Range("A2")), Month(BK.Sheets("1").Range("A2")), 0) '月底日
mDay = Day(Lastday)
For i = 1 To mDay
With BK.Sheets(i & "")
  1. Sub 下個月_理貨單_目的檔表頭值化()
  2. '比菲多理貨單
  3. Dim Lastday$, mDay%, BK As Workbook
  4. Dim myPath$, xFile$, i&

  6. Application.ScreenUpdating = False  '關閉屏幕更新
  7. Application.DisplayAlerts = False   '一般提警示訊息關閉
  8.     myPath = "U:\b\"                 '另存目的資料夾

  10.     xFile = Dir(myPath & "*.xlsx")          '目的資料夾檔名
  11.         Do While xFile <> ""
  12.             Application.DisplayAlerts = False       '一般提警示訊息關閉
  13.                 With Workbooks.Open(myPath & xFile)
  14.                     Set BK = Workbooks.Open(myPath & xFile) '開啟指定檔案
  15.                     Lastday = DateSerial(Year(BK.Sheets("1").Range("A2")), Month(BK.Sheets("1").Range("A2")), 0) '月底日
  16.                     mDay = Day(Lastday)
  17.                     For i = 1 To mDay   '在工作表中循環
  18.                         With BK.Sheets(i & "")
  19.                         .[G1] = .[G1].Value '值化
  20.                         .[A1] = .[A1].Value '值化
  21.                         End With
  22.                     Next i
  23.                         Sheets("1").Activate
  24.                         Range("P1:V2").ClearContents
  25.                         Sheets("1").Range("G1") = Sheets("2").Range("G1").Value
  26.                         ActiveWorkbook.Close True   '存檔後關閉檔案
  27.                 End With
  28.     xFile = Dir
  29.         Loop
  30.                 Application.ScreenUpdating = True   '打開屏幕更新

  32. End Sub
複製代碼

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
19#
發表於 2020-2-10 16:52 | 只看該作者
回復 17# PJChen

是因為妳要做For i = 1 To mDay的檔案已經關閉了

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
18#
發表於 2020-2-10 16:45 | 只看該作者
回復 15# 准提部林

了解,謝謝准大的指導

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
17#
發表於 2020-2-10 16:21 | 只看該作者
回復 15# 准提部林

請問准大,
For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '刪工作表
可以刪除大於月底日的工作表
但卡在這裡無法執行,是什麼問題?
                For i = 1 To mDay  '在工作表中循環
                    With xBK.Sheets(i & "")
                        Sheets("1").Activate
                        For k = 1 To [U1]

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

帖子
913 
主題
150 
精華
0 
積分
1089 
點名
0  
作業系統
win10 
軟體版本
office 2019 
閱讀權限
50 
性別
女 
註冊時間
2011-8-28 
最後登錄
2023-7-19 

論壇榮譽勳章論壇贊助勳章
16#
發表於 2020-2-10 16:17 | 只看該作者
回復 14# jcchiang

改這樣可以正常運作了
謝謝

TOP

准提部林

帖子
2848 
主題
10 
精華
0 
積分
2903 
點名
0  
作業系統
〔略〕 
軟體版本
〔略〕 
閱讀權限
100 
性別
男 
來自
〔略〕 
註冊時間
2013-5-13 
最後登錄
2026-7-25 
15#
發表於 2020-2-10 16:15 | 只看該作者
回復 14# jcchiang

i=31
sheets(i).delete = 刪除第31張工作表
sheets(i & "").delete = 刪除名稱"31"的工作表, 所以刪除方向不限

TOP

jcchiang

帖子
234 
主題
19 
精華
0 
積分
276 
點名
0  
作業系統
Windows XP 
軟體版本
office 2003 
閱讀權限
20 
性別
男 
註冊時間
2013-1-7 
最後登錄
2021-10-7 
14#
發表於 2020-2-10 11:49 | 只看該作者
回復 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

TOP

        靜思自在 : 有智慧才能分辨善惡邪正；有謙虛才能建立美滿人生。
123
返回列表 上一主題