返回列表 上一主題 發帖

[發問] 對應日期貼盤點資料

[發問] 對應日期貼盤點資料

本帖最後由 PJChen 於 2021-7-4 13:36 編輯

大大們好,
    With Sh
    Sh.Activate
        For j = 6 To xrow Step 2
            .Range("X" & j + 1 + 1).Resize(1, 16).Copy
            xW.Sheets("盤點").Range("BO" & 1 + j).Resize(1, 16).PasteSpecial xlPasteValues
        Next
    End With

盤點工作表從A欄的各客戶檔案把相應的盤點資料,copy過來
E4是指定日期
A欄是客戶名
當DI欄= D+0則從客戶檔案的數字工作表找E4-1的工作表
ex:E4=7/3,則找"2"工作表
將x:am的盤點資料,有庫存的數字,對應日期相符,貼到盤點工作表的BH:CF的欄位中

來源各客戶的檔案格式不會完全相同,但都是類似的,只以一定作範本,
盤點工作表中有很多的公式,所以貼上的資料不能干擾其他儲存格,
請問(紅字)對應日期貼上盤點數值的這段程式該怎麼寫?   貼盤點資料.rar (328.03 KB)
  1. Sub copy_蜜蜂盤點()
  2. Dim PH$, FN$, W As Workbook, xW As Workbook, xD As Worksheet, xS As Worksheet, Sh As Worksheet, i As String, rng As Range
  3. Set xD = ThisWorkbook.Sheets("VBA")  '程式來源
  4. k = xD.[V1] - 1 '取前一日
  5. i = Format(k, "D")
  6. y = Format(k, "yyyy")
  7. m = Format(k, "m")
  8. '---------------------
  9. Set xW = Workbooks("多客戶盤點表")
  10. PH = xD.[BB1]
  11. '---------------------
  12. FN = Dir(PH & "*蜜蜂*" & y & "*" & m & ".xlsx")
  13. Do While FN <> ""
  14. On Error Resume Next: Set W = Workbooks(FN): On Error GoTo 0
  15. If W Is Nothing Then Set W = Workbooks.Open(PH & FN)
  16. Set Sh = W.Sheets(i)
  17. With Sh
  18.     xrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row + 5
  19. End With
  20.      xW.Sheets("盤點").Range("M6:M" & xrow) = Sh.Range("T7:T" & xrow).Value '來源 前日結餘   
  21. With Sh
  22.     Sh.Activate
  23.         For j = 6 To xrow Step 2
  24.             .Range("X" & j + 1 + 1).Resize(1, 16).Copy
  25.             xW.Sheets("盤點").Range("BO" & 1 + j).Resize(1, 16).PasteSpecial xlPasteValues
  26.         Next
  27.     End With
  28.    
  29. FN = Dir
  30. Loop
  31. End Sub
複製代碼

本帖最後由 n7822123 於 2021-7-23 12:19 編輯

回復 32# PJChen

執行後還是連一筆資料都沒貼上

你先別用你的測試檔,你先用我上次上傳裡面的測試檔看看

如果還是一樣,那可能是環境問題,如果我的測試檔沒問題

那可能是你的儲存格資料沒有相對應、或者你又有其他檔案格式

我上次就發現你的"品名"  很有問題

還有說明盡量用"圖片",不然別人很難懂你在表達什麼
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 29# n7822123
大大,不好意思
執行後還是連一筆資料都沒貼上
另外,    iFile$ = Dir(iPath & "\*" & Keys(1) & "*.xls*")   '確認是否有此來源檔
實際的路徑有很多同事的檔案&類以的檔名,
如何在程式中排除不想比對的檔案?
例如:以下二個檔,不要加入比對中的話,要怎麼寫入程式中排除它?
佳佳(湖口廠)庫存表.xlsx
廠缺回饋.xlsx
0720_阿龍大大.rar (869.78 KB)

TOP

回復 21# n7822123
抱歉,這個品名中間沒有空格,是我打錯了

TOP

回復 27# PJChen

因為 工作表的Format(SP(2), "D") 與 x 對不到  改用文字格式比對看看
建議用 n7822123 前輩寫的會比較好 結果是一樣的 效率較高


Macro_1.rar (29.95 KB)

TOP

本帖最後由 n7822123 於 2021-7-21 22:54 編輯

回復 28# PJChen


我剛剛下載了論壇的檔案,測過沒問題呀

只開巨集檔,按下面按鈕就跑完了

你可以把多客戶盤點表,巨集要填的內容都刪除

執行後看看,因為給的附件應該是執行過的了

如果你都沒改程式的話,預設都放在同一個資料夾下

123.png
2021-7-21 22:49

321.png
2021-7-21 22:52
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 23# n7822123
n大好,
我下載附件測試,但程式都沒有反應,沒貼上任何資料,不知是有什麼特別測試方法嗎?

TOP

本帖最後由 PJChen 於 2021-7-21 22:20 編輯

回復 26# 軒云熊

熊大好,
舊的測試檔,都沒什麼問題,我會再用正式的檔案測看看
另,我新增了一個測試檔,發現無法運作,請幫我看一下
R_0721.rar (279.96 KB)

TOP

回復 22# PJChen

有空再幫我試試看 有沒有問題  我是分開寫 而且迴圈也比較多  
測試的時候 日期 可能要修改一下 有些檔案日期對應不到

n7822123前輩的寫法我還要再研究  慢慢吸收 ^^"  
感謝  n7822123前輩 不然會卡更久...呵呵..
0721.rar (937.48 KB)

TOP

回復 24# 軒云熊

沒錯,我在測試時也發現日期有2021 與 2022 兩種(有的保值期1年,有的才45天)

所以我把很多資料都改過了,為了測試

如果有看不懂的地方,再發問吧~用了一些技巧,

如果不用的話迴圈會變多,不容易Debug
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 待人退一步,愛人寬一寸,就會活得很快樂。
返回列表 上一主題