12
返回列表 上一主題 發帖

[發問] 下個月新檔

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 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2019-12-16 15:11 | 顯示全部帖子
回復 2# luhpro
lRow = .Cells(Rows.Count, 1).End(XlUp).Row    ' 1 表取得 A 欄最末有資料列號
這個檔我研究了很多天了,還是寫不出後面的程式，不知道如何套用到

2. 自動偵測商品.xlsx的列數(商品.xlsx會有最新的產品資料,而且列數會有增加及減少的可能性)
因為它偵測到 "飛比_暖暖.湖口.xlsx/ BF-QOO.xlsx"的列數後還要與來源檔 商品.xlsx比對,列數是多還是少?
依"商品.xlsx"的列數為準,
多的列數.....把多出來的刪除
少的列數.....把不足的列數新增
最後把"商品.xlsx" 的這三欄 "料號        入數        商品名稱"的值(不要格式)
copy到 目的資料夾的檔案(目前是 "飛比_暖暖.湖口.xlsx/ BF-QOO.xlsx")

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
3#
發表於 2019-12-29 18:03 | 顯示全部帖子
本帖最後由 PJChen 於 2019-12-29 18:04 編輯

Dear,
之前想要的做法完全做不出來,我想將程式這個功能單獨拉出來,使之簡化
以Workbooks("商品.xlsx").Sheets("新月") A4:C底 為資料來源
1) copy值到 "1.下個月理貨單_測試"資料夾中的每個檔案Sheets("出貨數")的A3:C
2) 再以Sheets("新月") A4:C底判斷列數
3) 當Sheets("出貨數")的A3:C的列數=Sheets("新月") A4:C 則存檔關閉
4) 當Sheets("出貨數")的A3:C的列數>Sheets("新月") A4:C 則 刪除多的列數 存檔關閉
5) 當Sheets("出貨數")的A3:C的列數<Sheets("新月") A4:C 則 把D欄公式往下複制,如同Sheets("新月") A4:C底 的列數 存檔關閉

現在做第一個copy資料的功能,一直無法正常貼資料,可否幫忙看下?? 下個月理貨單_測.rar (264.71 KB)

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
4#
發表於 2020-1-8 21:53 | 顯示全部帖子
回復 5# 蒼雪

先謝謝你的程式,
測試結果:程式會一直循環,停不下來,最後要按ESC去終止它,可以怎麼修正呢?......另
4)~5) 的判斷語法,哪位大大教學一下嗎?
1) copy值到 "1.下個月理貨單_測試"資料夾中的每個檔案Sheets("出貨數")的A3:C
2) 再以Sheets("新月") A4:C底判斷列數
3) 當Sheets("出貨數")的A3:C的列數=Sheets("新月") A4:C 則存檔關閉

4) 當Sheets("出貨數")的A3:C的列數>Sheets("新月") A4:C 則 刪除多的列數 存檔關閉
5) 當Sheets("出貨數")的A3:C的列數<Sheets("新月") A4:C 則 把D欄公式往下複制,如同Sheets("新月") A4:C底 的列數 存檔關閉

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
5#
發表於 2020-1-8 22:41 | 顯示全部帖子
回復 5# 蒼雪

後來改成這樣就不會一直循環了,現在我只剩4~5還沒成功....
  1.         Path = ".......\1.日班理貨換算表\"                 '另存目的資料夾
  2.         File = Dir(Path & "*.xlsx")          '來源檔名
  3.             Do While File <> ""
  4.             Set mySheet = Workbooks("商品.xlsx").Worksheets("新月")
  5.             iRow = mySheet.Cells(Cells.Rows.Count, "C").End(xlUp).Row  '看C欄位幾筆資料
  6. '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 來源資料夾 理貨單 Sheets("出貨數")新增.刪除
  7.                 With Workbooks.Open(Path & File)
  8.                     ActiveWorkbook.Sheets("出貨數").Activate
  9.                     Range("A3:C" & iRow - 1).Value = mySheet.Range("A4:C" & iRow).Value  'iRow計算來源檔的列數,從A4開始,目的檔從A3開始,會多貼一列,所以目的檔要-1
  10.                     ActiveWorkbook.Close True   '存檔後關閉檔案
  11.                 End With
  12. '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
  13.         File = Dir
  14.     Loop
  15. End Sub
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
6#
發表於 2020-1-14 15:58 | 顯示全部帖子
回復 9# 准提部林

謝謝准大,
稍修改路徑,執行OK

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
7#
發表於 2020-1-26 21:47 | 顯示全部帖子
本帖最後由 PJChen 於 2020-1-26 22:00 編輯

回復 9# 准提部林

請問准大,
同個檔案,Sheet以1~31命名,其中也有非數字的工作表,我需要一個可以刪除大於月底日工作表的功能(非數字的工作表不刪,目前排序,第一個工作表為文字工作表),如果當月正好是31天,也都不用刪除工作表,
程式碼很長,我只截取一部份,以下這句, 一直執行得很怪,存檔時為2月份日期,2月份有29日,它卻只刪除29、31的工作表,我需要刪除的是30、31的工作表,請問可以怎麼修正程式?
Sheets(j).Delete    '刪除大於月底日的工作表
  1.     Dim Path As String, myPath As String, File As String, xFile As String, i As String, m As String, xd As Long, j As Long, xJ As Long, k As Long
  2.     i = DateSerial(Year(Date), Month(Date) + 1, 1)  '設定下個月1日
  3.     m = Format(i, "M月") '設定下個月份
  4.     xd = Format(DateSerial(Year(Date), Month(Date) + 2, 1) - 1, "D")   '下個月底日變數

  6. With Workbooks.Open(Path & File)
  7.                 For j = 2 To ActiveWorkbook.Sheets.Count  '從#2開始的工作表中循環
  8.                     ActiveWorkbook.Sheets(j).Activate
  9.                         [A2] = [A2].Value '值化
  10.                         [B1] = [B1].Value '值化
  11.                         
  12.                         If j > xd Then
  13.                             Sheets(j).Delete    '刪除大於月底日的工作表
  14.                         End If
  15.                     Next
  16.                         Sheets("1").Activate
  17.                     For k = 1 To [U1]  '將U1儲存格的值,作為變數存取次數,依序命名檔案名並存檔
  18.                         [P1] = k   '指定儲存格的值
  19.                         ActiveWorkbook.SaveAs filename:=myPath & [G1] & " _" & m & ".xlsx"  'one by one 存檔k次
  20.                     Next
  21.                         ActiveWorkbook.Close True   '存檔後關閉檔案
  22.             End With
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
8#
發表於 2020-2-9 23:23 | 顯示全部帖子
回復 12# 准提部林

准大,
2月已經無法測試,3月又是31天,所以我測試4月
這句
For i = mDay + 1 To 31: BK.Sheets(i & "").Delete: Next i '刪工作表
與前面的Dim Lastday$, mDay%, xBK As Workbook不同,無法刪除大於月底日的工作表,所以我改為
For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i
刪除大於月底日的工作表可執行,但又有其他地方卡關,請幫忙看下是否我有弄錯的語法??
  1. Sub EX()
  2. Dim Path$, File$, i&, k&
  3. Dim Lastday$, mDay%, xBK As Workbook, BK As Workbook
  4. Dim myPath$, xFile$, m$, h$
  5. Lastday = DateSerial(Year(Date), Month(Date) + 3, 0) '下下個月月底
  6. mDay = Day(Lastday) '下個月天數
  7. h = DateSerial(Year(Date), Month(Date) + 2, 1)  '設定下個月1日
  8. m = Format(h, "M月") '設定下個月份
  9. Application.ScreenUpdating = False  '關閉屏幕更新
  10. Application.DisplayAlerts = False   '一般提警示訊息關閉
  11.     Path = "U:\a\1.下個月理貨單\"  '來源資料夾
  12.     myPath = "U:\b\"                 '另存目的資料夾

  14.         File = Dir(Path & "*.xlsx")          '來源檔名
  15.             Do While File <> ""
  16.                 With Workbooks.Open(Path & File)
  17.                         On Error Resume Next
  18.                         Sheets("1").Activate
  19.                         [A2] = Format(h, "M/D")   '輸入指定日期,為下個月1日
  20.                         ActiveWorkbook.Save '**存檔不關閉
  21.                 End With

  23. Set xBK = Workbooks.Open(Path & File) '開啟指定檔案

  25.             On Error Resume Next
  26.             For i = mDay + 1 To 31: xBK.Sheets(i & "").Delete: Next i '刪工作表
  27.             On Error GoTo 0

  29.             For i = 1 To mDay
  30.                 With xBK.Sheets(i & "")
  31.                     .[A2] = .[A2].Value '值化
  32.                     .[B1] = .[B1].Value '值化
  33.                 End With
  34.             Next i
  35.                 For i = 1 To mDay  '在工作表中循環
  36.                     With xBK.Sheets(i & "")
  37.                         Sheets("1").Activate
  38.                         For k = 1 To [U1]  '將U1儲存格的值,作為變數存取次數,依序命名檔案名並存檔
  39.                             [P1] = k   '指定儲存格的值
  40.                             ActiveWorkbook.SaveAs filename:=myPath & [V2] & [G1] & " _" & m & ".xlsx" 'one by one 存檔k次
  41.                         Next
  42.                             ActiveWorkbook.Close True   '存檔後關閉檔案
  43.                     End With
  44.                 Next i
  45.     File = Dir
  46.         Loop
複製代碼

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
9#
發表於 2020-2-10 16:17 | 顯示全部帖子
回復 14# jcchiang

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

TOP

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
10#
發表於 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

        靜思自在 : 口說好話、心想好意、身行好事。
12
返回列表 上一主題