彰化一整天的論壇

 找回密碼
 立即註冊
查看: 926|回復: 17

請問如何設定VBA自動判斷 [複製工作表某區間的資料]

[複製鏈接]
發表於 2020-12-25 08:39:44 | 顯示全部樓層 |閱讀模式
請見檔案壓縮檔案"VBA練習" 解壓縮後,當中有一個是"範例"活頁簿,另一個是"空白帳冊"活頁簿,兩個須同時開啟才能使用下方的VBA,
如果有大大可以幫忙設成只開啟範例, 就自動複製貼上資料到"空白帳冊"並同時刪除所複製的來源資料,那就更加感謝了!!

目前我只能夠使用下方判斷每個工作表在銷貨日期那一欄若沒有值(日期)則複製有資料的部分到"空白帳冊"活頁簿對應的客戶工作表裡面

Sub Copyandpastethendelete()

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

  Set wsCopy = Workbooks("範例.xlsm").Worksheets("泰C071")
  Set wsDest = Workbooks("空白帳冊.xlsm").Worksheets("泰C071")
   
    '1. Find last used row in the copy range based on data in column D
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
      
    '2. Find first blank row in the destination range based on data in column B
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
   
    '3. Copy & Paste Data
    wsCopy.Range("B17:X51" & lCopyLastRow).Copy _
      wsDest.Range("B7")
   
    '4. Clear contents of existing data range
    wsCopy.Range("B17:X51" & lDestLastRow).ClearContents

   
End Sub



藍色部分要自己KEY每個工作表的名稱, 紅色部分也是自己要看範圍區間去打,
請問有什麼辦法可以設定除了"範例"檔案裡面的第一個&第二個工作表以外,
其他無論多少個工作表都去判斷, 以及查對若B欄沒有值,就選取整個範圍複製貼上到空白帳冊活頁簿對應客戶的工作表裡面,
並刪除原始在"範例"活頁簿工作表當中的複製來源資料

附件有圖片是我執行上方程式後的截圖畫面,
但我不想每次只能自己手動設定每個工作表與區間範圍. 還請大家多多幫忙~
謝謝!!







3.空白帳冊的對應工作表已出現資料

3.空白帳冊的對應工作表已出現資料

2.執行後-範例下方資料刪除

2.執行後-範例下方資料刪除

1. 原始範例資料內容

1. 原始範例資料內容

VBA練習.rar

167.69 KB, 下載次數: 2

售價: 2 金錢  [記錄]  [購買]

範例與空白帳冊活頁簿

回復

使用道具 舉報

發表於 2020-12-25 09:59:28 來自手機 | 顯示全部樓層
本帖最後由 yws0915 於 2020-12-25 10:00 編輯

http://discuz.bestdaylong.com/forum.php?mod=viewthread&tid=39059&extra=&page=2&mobile=2

跟我這篇類似,8樓的帖子可以參考
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2020-12-25 10:08:55 | 顯示全部樓層
yws0915 發表於 2020-12-25 09:59
http://discuz.bestdaylong.com/forum.php?mod=viewthread&tid=39059&extra=&page=2&mobile=2

跟我這篇類 ...

不好意思進去後是什麼掌上論壇手機畫面欸...連結好像有錯喔!
回復 支持 反對

使用道具 舉報

發表於 2020-12-25 14:14:57 | 顯示全部樓層
yws0915 發表於 2020-12-25 09:59
http://discuz.bestdaylong.com/forum.php?mod=viewthread&tid=39059&extra=&page=2&mobile=2

跟我這篇類 ...

請參考.
http://discuz.bestdaylong.com/fo ... hread&tid=39059
回復 支持 反對

使用道具 舉報

 樓主| 發表於 2020-12-25 14:58:49 | 顯示全部樓層
imingho 發表於 2020-12-25 14:14
請參考.
http://discuz.bestdaylong.com/forum.php?mod=viewthread&tid=39059

看到了,謝謝imingho大大,但...我不知道如何設定...感覺狀況還是不大一樣~"~
回復 支持 反對

使用道具 舉報

發表於 2020-12-25 15:34:30 | 顯示全部樓層
luckysan 發表於 2020-12-25 14:58
看到了,謝謝imingho大大,但...我不知道如何設定...感覺狀況還是不大一樣~"~

我先修改單一個的語法,您先看看是否看得懂,若懂的話,我再往下加功能。
  1. Sub Copyandpastethendelete()

  2.     Dim wsCopy As Worksheet
  3.     Dim wsDest As Worksheet
  4.     Dim lCopyLastRow As Long
  5.     Dim lDestLastRow As Long

  6.     Set wsCopy = Workbooks("範例.xlsm").Worksheets("泰C071")
  7.     Set wsDest = Workbooks("空白帳冊.xlsm").Worksheets("泰C071")
  8.    
  9.    
  10.     '1. Find last used row in the copy range based on data in column D
  11.     lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
  12.      
  13.     '2. Find first blank row in the destination range based on data in column B
  14.     'Offset property moves down 1 row
  15.     lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
  16.    
  17.     '3. Copy & Paste Data 範圍" "須自行對照key
  18.     wsCopy.Range("B13:X" & lCopyLastRow).Copy _
  19.       wsDest.Range("B" & lDestLastRow)
  20.    
  21.     '4. Clear contents of existing data range 範圍" "須自行對照key
  22.     wsCopy.Range("B13:X" & lDestLastRow).ClearContents
  23.    
  24. End Sub
複製代碼
還有張貼程式碼請參考.如何在discuz張貼程式碼
http://discuz.bestdaylong.com/fo ... 30239&fromuid=2
(出處: 彰化一整天的論壇)



範例_20201225A.xlsm

93.47 KB, 下載次數: 1

售價: 1 金錢  [記錄]

回復 支持 反對

使用道具 舉報

發表於 2020-12-25 15:51:13 | 顯示全部樓層
luckysan 發表於 2020-12-25 14:58
看到了,謝謝imingho大大,但...我不知道如何設定...感覺狀況還是不大一樣~"~
  1. Sub Copyandpastethendelete()

  2.     Dim wsCopy As Worksheet
  3.     Dim wsDest As Worksheet
  4.     Dim lCopyLastRow As Long
  5.     Dim lDestLastRow As Long
  6.    
  7.     Dim i As Integer
  8.    
  9.     For i = 3 To Worksheets.Count

  10.          Set wsCopy = Worksheets(i)
  11.          Set wsDest = Workbooks("空白帳冊.xlsm").Worksheets(i)
  12.         
  13.         
  14.          '1. Find last used row in the copy range based on data in column D
  15.          lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
  16.          
  17.          '2. Find first blank row in the destination range based on data in column B
  18.          'Offset property moves down 1 row
  19.          lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
  20.         
  21.          '3. Copy & Paste Data 範圍" "須自行對照key
  22.          wsCopy.Range("B13:X" & lCopyLastRow).Copy _
  23.            wsDest.Range("B" & lDestLastRow)
  24.         
  25.          '4. Clear contents of existing data range 範圍" "須自行對照key
  26.          wsCopy.Range("B13:X" & lDestLastRow).ClearContents
  27.    Next
  28. End Sub
複製代碼


範例_20201225B.xlsm

92.6 KB, 下載次數: 1

售價: 1 金錢  [記錄]

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2020-12-25 16:44:01 | 顯示全部樓層

謝謝imingho大大, 我看的懂set那邊了,但是我實際測試後, 開啟範例與空白帳冊來執行, 卻出現有的工作表整個複製過去空白帳冊工作表的對應客戶工作表, 因為我只要複製沒有銷貨日期的資料範圍而已, 且在"範例"這個活頁簿裡面的客戶工作表, 裡面的資料我習慣一筆銷貨會空白一列,所以某些工作表,不一定是連續資料範圍, 再請imingoho大大看看在範例工作表其他工作表的資料分佈方式了,
例如菲C407 & 泰C071 工作表就是我所說的情況
回復 支持 反對

使用道具 舉報

發表於 2020-12-26 09:49:43 | 顯示全部樓層
luckysan 發表於 2020-12-25 16:44
謝謝imingho大大, 我看的懂set那邊了,但是我實際測試後, 開啟範例與空白帳冊來執行, 卻出現有的工作表整 ...

請修改如下試看看.
  1. Sub Copyandpastethendelete()

  2.     Dim wsCopy As Worksheet
  3.     Dim wsDest As Worksheet
  4.     Dim lCopyLastRow As Long
  5.     Dim lCopyFirstRow As Long
  6.     Dim lDestLastRow As Long

  7.     Set wsCopy = Workbooks("範例.xlsm").Worksheets("菲C407")
  8.     Set wsDest = Workbooks("空白帳冊.xlsm").Worksheets("菲C407")
  9.    
  10.     '1. Find last used row in the copy range based on data in column D
  11.     lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "D").End(xlUp).Row
  12.     lCopyFirstRow = wsCopy.Cells(wsCopy.Rows.Count, "B").End(xlUp).Offset(1).Row
  13.     '2. Find first blank row in the destination range based on data in column B
  14.     'Offset property moves down 1 row
  15.     lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row
  16.    
  17.     '3. Copy & Paste Data 範圍" "須自行對照key
  18.     wsCopy.Range("B" & lCopyFirstRow & ":X" & lCopyLastRow).Copy _
  19.       wsDest.Range("B" & lDestLastRow)
  20.    
  21.     '4. Clear contents of existing data range 範圍" "須自行對照key
  22.     wsCopy.Range("B" & lCopyFirstRow & ":X" & lCopyLastRow).ClearContents
  23.    
  24. End Sub
複製代碼


範例.xlsm

95.62 KB, 下載次數: 1

售價: 1 金錢  [記錄]

回復 支持 反對

使用道具 舉報

 樓主| 發表於 2020-12-26 16:41:20 | 顯示全部樓層
imingho 發表於 2020-12-26 09:49
請修改如下試看看.

測試結果不行, 我只需要將還沒有銷貨資料的複製到空白帳冊而已,但您的程式中還會將已經銷貨的也帶到了空白帳冊去, 另外執行後,空白帳冊的一個客戶工作表,會多留一行空白列在B7那一列
回復 支持 反對

使用道具 舉報

您需要登錄後才可以回帖 登錄 | 立即註冊

本版積分規則

 ㄚ母滴雞湯
 員林香純滴雞精

Archiver|手機版|小黑屋|彰化一整天的論壇(Excel,Office)

GMT+8, 2021-2-25 05:12 , Processed in 0.137392 second(s), 20 queries .

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回復 返回頂部 返回列表