VBA代码运行两个循环非常慢 [英] VBA code runs two loops very slow
本文介绍了VBA代码运行两个循环非常慢的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
如果您看到此代码花费了这么长时间的原因,请让我知道
Sub BSIS()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lngRow As Long
Dim counter As Long
'合并具有重复单元格的行
使用ActiveSheet
.Cells(1).CurrentRegion.Sort key1:=。Cells(1),Header:= xlYes'change如果你的表具有标题单元格
对于lngRow = ActiveSheet.UsedRange.Rows.Count到2 Step -1
如果ActiveSheet.Cells(lngRow - 1,1) )= ActiveSheet.Cells(lngRow,1)然后
.Cells(lngRow - 1,4)= .Cells(lngRow - 1,4)+ .Cells(lngRow,4)
.Rows(lngRow )。删除
结束如果
下一个lngRow
结束
'删除带有单元格的行
ActiveSheet
对于counter = ActiveSheet.UsedRange.Rows.Count到1 Step -1
如果ActiveSheet.Ce lls(counter,4)< = 0然后
.Rows(counter).Delete
End If
下一个计数器
结束
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
解决方案
缓慢运行的原因是您逐个删除行。
最好使用 UNION 功能
尝试以下代码,它应该工作,(测试)
Dim uni As Range
With ActiveSheet
.Cells(1).CurrentRegion。排序key1:=。单元格(1),标题:= xlYes
对于lngRow = ActiveSheet.UsedRange.Rows.Count到2步骤-1
如果ActiveSheet.Cells( lngRow - 1,1)= ActiveSheet.Cells(lngRow,1)然后
.Cells(l ngRow - 1,4)= .Cells(lngRow - 1,4)+ .Cells(lngRow,4)
如果不是uni Is Nothing然后
设置uni = Application.Union(uni,Range(。 Rows(lngRow).Address))
Else
Set uni = Range(.Rows(lngRow).Address)
End If
End If
下一页lngRow
uni.Delete
结束
I have this code which runs two loops after each other. It works fine for a few thousand rows. But as the number of rows increases, the code runs significantly longer. It should loop over 100.000 rows but this will take hours and hours. Please let me know if you see a reason why this code is taking so long
Sub BSIS()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim lngRow As Long
Dim counter As Long
'Merge rows with duplicate Cells
With ActiveSheet
.Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes 'change this to xlYes if your table has header cells
For lngRow = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If ActiveSheet.Cells(lngRow - 1, 1) = ActiveSheet.Cells(lngRow, 1) Then
.Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4) + .Cells(lngRow, 4)
.Rows(lngRow).Delete
End If
Next lngRow
End With
'Delete rows with negative cells
With ActiveSheet
For counter = ActiveSheet.UsedRange.Rows.Count To 1 Step -1
If ActiveSheet.Cells(counter, 4) <= 0 Then
.Rows(counter).Delete
End If
Next counter
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
解决方案
The reason for slow run is that you are deleting rows one by one.
It always better to do it in single shot using UNION function
Try the below code it should work,(Tested)
Dim uni As Range
With ActiveSheet
.Cells(1).CurrentRegion.Sort key1:=.Cells(1), Header:=xlYes
For lngRow = ActiveSheet.UsedRange.Rows.Count To 2 Step -1
If ActiveSheet.Cells(lngRow - 1, 1) = ActiveSheet.Cells(lngRow, 1) Then
.Cells(lngRow - 1, 4) = .Cells(lngRow - 1, 4) + .Cells(lngRow, 4)
If Not uni Is Nothing Then
Set uni = Application.Union(uni, Range(.Rows(lngRow).Address))
Else
Set uni = Range(.Rows(lngRow).Address)
End If
End If
Next lngRow
uni.Delete
End With
这篇关于VBA代码运行两个循环非常慢的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文