返回列表 上一主題 發帖

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

PJChen
　暱稱: PJ

大學生Rank: 4

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

論壇榮譽勳章論壇贊助勳章
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2018-5-27 23:27 | 只看該作者

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

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

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

  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
複製代碼
收藏 分享

        靜思自在 : 君子如水，隨方就圓，無處不自在。
返回列表 上一主題