如果0或“”删除行：代码工作但很慢 [英] If 0 or "" delete row: code works but very slow

问题描述

问题：

在本论坛的录音机和帮助下，我做了一个代码（一个按钮）。列我已经（从第25行）'Pcs'或一个数字。我的宏找到Pcs并将其更改为，而宏删除和0。填充单元的长度是可变的，所以我做了500作为结束，但从来没有达到。如果我运行宏，它的工作和工作，但需要很长时间，特别是因为它必须做500行..

With the recorder and help on this forum I made a code (for a button). Column 'i' has got (from row 25) 'Pcs' or a number. My Macro finds Pcs and changes it to "" and than the macro deletes "" and 0's. lenght of the filled cells is variable, so I made 500 as 'end' but it never reaches that. If I run the macro, it works and does the job, but takes very long, especially because it has to do 500 lines..

Sub Fix()

Dim intEnd As Integer
Range("M1").Select
Cells.Replace What:="pcs", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
intEnd = 500

Range("I25").Select

Do Until ActiveCell.Row = intEnd

If Int(ActiveCell.Value) = 0 Then
Range(ActiveCell.Row & ":" & ActiveCell.Row).Delete
intEnd = intEnd - 1
Else
ActiveCell.Offset(1, 0).Select
End If

Loop
End sub

我很高兴我可以通过论坛和录音机，但现在我被卡住了加速，没有什么真正的线索从哪里开始。有没有人有提示？

I was happy that I could make this macro with help of the forum and the recorder, but now I am stuck speeding it up, no real clue where to start. Does anybody has a tip?

谢谢，如果需要更多的信息或努力，请让我知道。

Thanks, if more info or effort needed, please let me know.

推荐答案

尝试这样：

Sub fix3()


Dim intEnd As Long
Dim ws As Worksheet
Dim i As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

On Error GoTo getout
Set ws = Sheets("Sheet1") 'Change to your sheet
ws.Cells.Replace What:="pcs", Replacement:="", LookAt:=xlPart, SearchOrder _
    :=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False

intEnd = ws.Range("I" & ws.Rows.Count).End(xlUp).row

For i = intEnd To 25
    If Int(ws.Cells(i, "I").Value) = 0 Then
        ws.Rows(i).Delete
    End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
Exit Sub

getout:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

这篇关于如果0或“”删除行：代码工作但很慢的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！