返回列表 上一主題 發帖

請問各位大神加快 VBA 刪除為0的儲存格公式的程式寫法

請問各位大神加快 VBA 刪除為0的儲存格公式的程式寫法

以下是我爬文抓到的,但實用後跑檔案10MB,

工作表中  D欄  判斷並刪除 100筆左右0的公式資料,花了7分鐘,
請問如何加快程式碼跑的速度呢?

如何加快此 VBA  Module10 程式的速度呢?
Sub TT()

Dim t1
   
    t1 = Timer   '這是產生秒數的 MSG
   '==============================================================

  '刪除  D 欄(儲存格 O2~O101)為0時的儲存格公式資料
  
   Range("D2").Select
   
     For X = 1 To 1
     For y = 2 To 101

     If ActiveCell(y, X) = 0 Then

        ActiveCell(y, X) = ""

     Else
     
     End If
     
     
     Next y
     
     Next X


'以下為顯示VBA Run程式的時間 + 這是產生秒數的 MSG
MsgBox "抓資料完成!  " & Chr(10) & "使用時間:" & Round(Timer - t1, 2) & " 秒" & Chr(10) & "您輸入的條件比對後,共計有" & "  " & Application.CountA(Sheets("比對廠編後資料").Columns("A:A")) - 1 & "  " & "筆資料"
  
'以下為產生Msgbox 說明比對後有幾筆不重複的資料
    'MsgBox "您輸入的" & "條件" & "比對後,共計有" & "  " & APplication.CountA(Sheets("比對廠編後資料").Columns("A:A")) - 1 & "  " & "筆資料"
   

End Sub


'==============================================================


檔案下載: ABC 20191219-V.04版.rar (167.63 KB)

'刪除  D 欄(儲存格 D2~D101)為0時的儲存格公式資料

應該是 D2 ~ D101

TOP

不好意思,是我另一個模糊查詢表資料有3000筆導致速度變慢,我已經將模糊查詢表查詢條件改掉舊便很快了。謝謝各位。

TOP

本帖最後由 adrian_9832 於 2019-12-20 21:10 編輯

假設 每次D那行   0 數值那行的資料  沒有中斷  而且資料都是 一直是0  而且不會  0  0  0  0 之後不是  0   再之後又是  0      

Sub test()


i = 2


Do Until Cells(i, 4) = ""

    If Cells(i, 4) = "0" Then
        Count = Count + 1
    Else
        Start = i
    End If
   
   

i = i + 1
Loop


Range("d" & Start + 1 & ":" & "d" & Count + 10).Select

Selection.ClearContents

End Sub


最後提醒一下 以上只可以在  一行 都是 0  才能用
比如以下這樣:
111
222
333
abc
123aft
2t1111
0
0
0
0
0
0
0
0
0
0
0
0
....

而不是這樣情況下用
0
0
0
1
0
1
0
1
0
1
0
1
0
0
0
1
0
1
擷取.PNG

TOP

本帖最後由 adrian_9832 於 2019-12-20 21:23 編輯
  1. 方法2:
  2. Sub test2()

  3.     Columns("D:D").Select
  4.     Selection.SpecialCells(xlCellTypeFormulas, 1).Select
  5.     Selection.ClearContents
  6. End Sub
複製代碼
這可以隔資料   而且簡單 快捷

TOP

回復 4# adrian_9832


    大大您好:實測結果是OK的,我的電腦速度約70秒。感謝大大的指導分享。

TOP

回復 5# adrian_9832


        大大您好:實測結果是OK的,我的電腦速度也是約70秒。感謝大大的指導分享。

TOP

本帖最後由 quickfixer 於 2019-12-24 05:30 編輯

回復 1# jeffrey628litw

你的頭尾各加1行Application.Calculation,就可以跑很快了
ABC 20191219-V.04版,沒修改前,我的電腦要跑40秒
sub tt()
       Application.Calculation = xlCalculationManual

你的程式碼

       Application.Calculation = xlCalculationAutomatic
end sub
執行結果如下
Image 8.png
2019-12-24 05:20


用4f,5f更快
sub tt()
       Application.Calculation = xlCalculationManual
4f,5f程式碼
       Application.Calculation = xlCalculationAutomatic
end sub
執行結果如下
Image 9.png
2019-12-24 05:27

TOP

回復 8# quickfixer

  感謝大神的協助,超感激的。

TOP

        靜思自在 : 閒人無樂趣,忙人無是非。
返回列表 上一主題