[發問] 程式無法清除資料,而且執行速度很慢

PJChen

請問二個問題:       手動Label.rar (270.11 KB)

下載次數: 7

2018-5-27 23:20

1. 這段程式是先將Sheets("Label (3)")的J2~J end的資料清除，但這個卻寫法無法清除資料.

1.    Set Wb = Workbooks("最新庫存.xlsx")
   
2.     Set S = Wb.Sheets("Label (3)")
   
3.     S.Select
   
4.     With S
   
5.     Set A = .Range("J2", .Range("J2").End(xlDown))  '從指定點到資料最底部....但這個寫法不能自動清除
   
6.     A.ClearContents  '清除資料
   
7.     End With

複製代碼

2.  Sheets("Label (3)")已手動把需要打勾的部份手動補上，原本的的資料有好幾千列，這個寫法在執行時會停頓很久，像程式快當掉的感覺，請問是否有不同寫法，可以讓它執行快一點？
這個程式的執行過程是讓J欄打勾的部份，全部新增二列，然後將原本打勾的同列C欄資料,複制貼上到新增列的B欄中，如果無法明白我的解說，請將附件的檔案執行看看，可能比較容易懂，不過因為資料已經減少了，可能比較不感覺"卡卡"的，不過真實情況是跑得很不理想.

1.    Set Wb = Workbooks("最新庫存.xlsx")
   
2.     Wb.Activate
   
3.    
   
4.     Set S = Wb.Sheets("Label (3)")
   
5.    With S
   
6.     .UsedRange.AutoFilter Field:=10, Criteria1:="", Operator:=xlAnd  '空格的資料刪除
   
7.     Set xRng = .UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible)  '選擇有資料的範圍刪除,Offset(1, 0)表示表頭往下一列開始
   
8.     xRng.Delete
   
9.     .UsedRange.AutoFilter Field:=10 '取消篩選
   
10.     End With
    
11. 
    
12.    With S
    
13.         LastRow = ActiveSheet.UsedRange.SpecialCells(xlLastCell).Row
    
14.         For J = 1 To LastRow
    
15.             If Range("J" & J).Value = "V" Then
    
16.                 LastRow = LastRow + 2
    
17.             End If
    
18.         Next J
    
19.    
    
20.         For J = 1 To LastRow
    
21.         If Range("J" & J).Value = "V" Then  'J欄"V",則新增2列
    
22.         Rows(J + 1).Insert Shift:=xlDown
    
23.         Rows(J + 1).Insert Shift:=xlDown
    
24.         Range("C" & J).Copy
    
25.         Range("B" & J + 1).Select   '"V"同列的C欄值copy到新增第1列的B欄
    
26.         ActiveSheet.Paste
    
27.         End If
    
28.     Next J
    
29. End With
    
30.    
    
31.         ActiveWorkbook.SaveAs "D:\5_VBA輸出報表\庫存_" & Format(Date, "YYYYMMDD") & "." & Format(Time, "HHMM") & ".xlsx"
    
32.     Kill "D:\Download\暫存\最新庫存.xlsx"
    
33.     End Sub

複製代碼