为vbamacrosexcel 2007优化循环

我有这个代码工作。 它下降一个范围，并删除空的行，将第一个字符分成不同的列，如果它不是一个数字或负号。
此代码工作。 但是对于需要处理的数据量来说太慢了。 谢谢大家对于如何优化代码并使其更快的build议。

我已经closures了自动计算。 屏幕更新。 和应用程序的可见性。

Dim rng As Range Dim i As Long Dim Tracking As Long Dim textval As String Dim limitz As String Dim remaining As String Range("B1").End(xlDown).Offset(0, 5).Select Set rng = Range("G2", ActiveCell).Select i = 1 Range("G2").Select For Tracking = 1 To rng.Rows.Count textval = rng.Cells(i).Value limitz = Left(textval, 1) If limitz = "" Then rng.Cells(i).EntireRow.Delete ElseIf limitz <> "0" And limitz <> "1" And limitz <> "2" And limitz <> "3" And limitz <> "4" And limitz <> "5" And limitz <> "6" And limitz <> "7" And limitz <> "8" And limitz <> "9" And limitz <> "-" Then remaining = Right(textval, Len(textval) - 1) rng.Cells(i) = remaining rng.Cells(i).Offset(0, 1).Value = limitz i = i + 1 Else i = i + 1 End If Next 

Answer 1

没有太多的代码似乎显然是低效的 。

这里有一些关于我可以告诉的技巧：

• 不要select单元格，除非你真的被迫（因为它不在你的循环中，这不是最糟糕的事情）
• 尝试parsingrange而不是使用Long
• 用像IsNumeric这样的vba语句改变你的testing
• 用于避免多次调用对象

这里是一个尝试（我可能已经改变了一些行为，因为我不明白，如果你想parsing单元格或行）：

 Sub test() Dim rng As Range, row As Range Dim i As Long Dim textval As String Dim limitz As String Dim remaining As String Set rng = Range("G2", Range("B1").End(xlDown).Offset(0, 5)) i = 1 For Each row In rng.Rows With row textval = .Cells(i).Value limitz = Left(textval, 1) If limitz = "" Then .Cells(i).EntireRow.Delete ElseIf limitz <> "-" And Not IsNumeric(limitz) Then remaining = Right(textval, Len(textval) - 1) With .Cells(i) .Value = remaining .Offset(0, 1).Value = limitz End With i = i + 1 Else i = i + 1 End If End With Next End Sub 

Answer 2

您应该从底部到顶部处理行：应该更快，因为每次删除都会导致更less的行向上移动。

未经testing：

 Sub test() Dim rng As Range, c As Range Dim numRows As Long Dim Tracking As Long Dim textval As String Dim limitz As String Set rng = Range("G2", Range("B1").End(xlDown).Offset(0, 5)) numRows = rng.Rows.Count For Tracking = numRows To 1 Step -1 Set c = rng.Cells(Tracking) textval = c.Value limitz = Left(textval, 1) If limitz = "" Then c.EntireRow.Delete ElseIf Not limitz Like "[0-9-]" Then c.Value = Right(textval, Len(textval) - 1) c.Offset(0, 1).Value = limitz End If Next End Sub 

Answer 3

这应该是相当快速的。 希望我没有太多改变你的代码来改变我不应该有的东西。

抓取变体中的所有数据使得它更快，因为VBA不必与Excel交互太多。 使用特殊的细胞也做到这一点。 使用“like”清理代码，不知道性能是否更好。

 Dim rng As Range Dim vData As Variant Dim i As Long Dim limitz As String Set rng = Range("G2", Range("B1").End(xlDown).Offset(0, 5).Address) 'Delete empty cells On Error Resume Next rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete On Error GoTo 0 'Get all data in range vData = rng.Resize(, 2) For i = 1 To UBound(vData) limitz = Left$(CStr(vData(i, 1)), 1) If limitz Like "[!0-9,!-]" Then vData(i, 1) = Right$(CStr(vData(i, 1)), Len(vData(i, 1)) - 1) vData(i, 2) = limitz End If Next rng.Resize(, 2) = vData 

下面的代码是未经testing，但应该工作，并走得很快。 应该指出，删除整行是相当昂贵的（时间明智的），尽pipe你可以使用下面的方法尽量减less时间，但仍然需要一段时间，你可以做的事情不多：

 dim bUnion as boolean Dim rng As Range, rUnion as range Dim vData As Variant Dim i As Long Dim limitz As String Set rng = Range("G2", Range("B1").End(xlDown).Offset(0, 5).Address) 'Get all data in range vData = rng.Resize(, 2) bunion=false For i = 1 To UBound(vData) if len(vdata(i,1))>0 THEN limitz = Left$(CStr(vData(i, 1)), 1) If limitz Like "[!0-9,!-]" Then vData(i, 1) = Right$(CStr(vData(i, 1)), Len(vData(i, 1)) - 1) vData(i, 2) = limitz End If else if bunion then set runion=union(runion,range("A" & i+1)) else set runion=range("A" & i+1) bunion=true end if end if Next rng.Resize(, 2) = vData runion.entirerow.delete