[英]Optimizing loop for vba macro excel 2007
我有这个代码有效。 它向下移动一个范围并删除空行,如果它不是数字或负号,则将第一个字符分隔成不同的列。
这段代码工作。 但是对于我需要它处理的数据量来说太慢了。 感谢任何人提出有关如何优化此代码并使其更快的建议。
我已经关闭了自动计算。 屏幕更新。 和应用的可见性。
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
似乎没有那么多代码显然效率低下 。
以下是我可以告诉的一些提示:
range
而不是使用Long IsNumeric
这样的vba语句更改测试 With
可避免多次调用对象 这是一个尝试(我可能已经改变了一些行为,因为我无法理解你是否要解析单元格或行):
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
您应该从底部到顶部处理您的行:应该更快,因为每次删除都会导致更少的行向上移动。
未经测试:
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
这应该是非常快的。 希望我没有太多改变你的代码来改变我不应该拥有的东西。
抓取变体中的所有数据会使速度更快,因为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
以下代码未经测试但应该可以正常运行。 应该注意的是,删除整行是相当昂贵的(时间方面),虽然你可以使用下面的方法最小化时间,它仍然需要一段时间,你可以做的事情并不多:
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.