帖子: 228
主題: 62
精華: 0
積分: 364
點名: 20
作業系統: Win 10
軟體版本: Office 2007 & 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-3-5
最後登錄: 2024-9-16

2011兔年全勤獎章

1^# 跳轉到 » 正序看帖

字體大小: tT

發表於 2019-12-20 09:46 | 只看該作者

請問各位大神加快 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)

樓主熱帖

jeffrey628litw

中學生 Rank: 2

帖子: 228
主題: 62
精華: 0
積分: 364
點名: 20
作業系統: Win 10
軟體版本: Office 2007 & 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-3-5
最後登錄: 2024-9-16

2011兔年全勤獎章

9^#

發表於 2019-12-24 18:26 | 只看該作者

回復 8# quickfixer

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

TOP

quickfixer

中學生 Rank: 2

帖子: 154
主題: 1
精華: 0
積分: 200
點名: 28
作業系統: windwos 7
軟體版本: 64bit
閱讀權限: 20
註冊時間: 2017-5-29
最後登錄: 2024-10-22

8^#

發表於 2019-12-24 05:22 | 只看該作者

本帖最後由 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
執行結果如下

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

TOP

jeffrey628litw

中學生 Rank: 2

帖子: 228
主題: 62
精華: 0
積分: 364
點名: 20
作業系統: Win 10
軟體版本: Office 2007 & 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-3-5
最後登錄: 2024-9-16

2011兔年全勤獎章

7^#

發表於 2019-12-20 21:40 | 只看該作者

回復 5# adrian_9832

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

TOP

jeffrey628litw

中學生 Rank: 2

帖子: 228
主題: 62
精華: 0
積分: 364
點名: 20
作業系統: Win 10
軟體版本: Office 2007 & 2010
閱讀權限: 20
性別: 男
註冊時間: 2011-3-5
最後登錄: 2024-9-16

2011兔年全勤獎章

6^#

發表於 2019-12-20 21:40 | 只看該作者

回復 4# adrian_9832

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

TOP

adrian_9832

中學生 Rank: 2

帖子: 79
主題: 19
精華: 0
積分: 148
點名: 0
作業系統: WINDOW7
軟體版本: EXCEL 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-5-21
最後登錄: 2023-3-13

5^#

發表於 2019-12-20 21:22 | 只看該作者

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

方法2:
Sub test2()
Columns("D:D").Select
Selection.SpecialCells(xlCellTypeFormulas, 1).Select
Selection.ClearContents
End Sub

複製代碼

這可以隔資料而且簡單快捷

TOP

adrian_9832

中學生 Rank: 2

帖子: 79
主題: 19
精華: 0
積分: 148
點名: 0
作業系統: WINDOW7
軟體版本: EXCEL 2003
閱讀權限: 20
性別: 男
註冊時間: 2017-5-21
最後登錄: 2023-3-13

4^#

發表於 2019-12-20 21:02 | 只看該作者

本帖最後由 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 (86.44 KB)