[發問] 下個月新檔

PJChen

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)

下載次數: 6

2019-11-26 00:03

luhpro

Dear,
...
1. 自動偵測商品.xlsx是否已開啟,已開則忽略,未開則打開...
PJChen 發表於 2019-11-26 00:04

先解決你的第一個問題,
在你發的那串 : [發問] 自動套表 5# 第 5 篇裡,
我的回文裡有一段就是在處理你這個需求 :

1. sPath = ThisWorkbook.Path ' 如果要指定目錄, 只要改成該目錄即可, 如 sPath = "D:"
   
2.    sFlName = "商品.xlsx"
   
3.    bMatch = False ' 檢查 '商品.xlsx' 檔案是否已開啟
   
4.   For iI = 1 To Workbooks.Count
   
5.      If Workbooks(iI).Name = sFlName Then
   
6.        bMatch = True
   
7.        Exit For
   
8.      End If
   
9.    Next iI
   
10.    If bMatch Then
    
11.      Set wsTar = Workbooks(sFlName).Sheets("飛比商品")  ' 檔案已開啟, 直接取用
    
12.      wsTar.Activate
    
13.    Else
    
14.      Set wsTar = Workbooks.Open(Filename:=sPath & "\" & sFlName).Sheets("飛比商品")  ' 檔案尚未開啟, 開啟後取用
    
15.    End If
    
16.    With wsTar
    
17.   ....
    
18.   End With

複製代碼

取用時只要在 With wsTar  與 End With 兩行間用 . 開頭的指令即可,
例如 :    .[A5] = 16   或   .Cells(3,5)=2    ...等

2. 自動偵測商品.xlsx的列數(商品.xlsx會有最新的產品資料,而且列數會有增加及減少的可能性)

最末列號可以用類似

1.   lRow = .Cells(Rows.Count, 1).End(XlUp).Row    ' 1 表取得 A 欄最末有資料列號  

複製代碼

取得
有事先下了,
其它的若我有時間上來再互相討論.

PJChen

回復 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")

PJChen

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)

下載次數: 7

2019-12-29 18:04

蒼雪

回復 4# PJChen


    小弟我試著改了一下，請服用。

    原本你寫的我有保留，變成註解情況，可以跟我寫的區塊比對一下。

    因為要抓商品的row數量，所以 cells(rows.count,"C").end(xlup).row 必須是以...

    workbooks("商品.xlsx").WORKSHEETS("新月").cells(rows.count,"C").end(xlup).row下去寫，才會去抓到該Sheet的row數量。

    前提是workbook 商品是要開啟的狀態。 Macro_T.zip (14.6 KB)

下載次數: 6

2020-1-5 23:21

PJChen

回復 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底 的列數 存檔關閉

PJChen

回復 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

複製代碼

蒼雪

回復 6# PJChen


    會循環嗎...我自己在run的時候是沒問題啦XD

准提部林

測試檔:
TEST001.rar (96.64 KB)

下載次數: 11

2020-1-14 11:15

PJChen

回復 9# 准提部林

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