[英]VBA Optimizing macro loop
场景是我有 40 张纸,每张纸最多可以有约 5k 行,所以我正在处理大量数据,这导致此宏运行速度极慢。 例如,仅第一张纸就有大约 15219162 次计算,其中只有大约 380 行。 有没有办法减少我的宏必须运行的计算量?
到目前为止,有 39326 个 unqiue twitter 名称,这意味着第一页中有 39326 x 387 行。
Sub CountInvestorsByTwitterName()
With Application
.Calculation = xlCalculationManual: .ScreenUpdating = False: .DisplayAlerts = False
End With
Dim row_total As Long
Dim Unique_Values_Sheet As Worksheet
Set Unique_Values_Sheet = Sheets(Sheets.Count)
Unique_Values_Sheet.Columns("B:XFD").EntireColumn.Delete
Dim Unique_Values_Sheet_row_total As Long
Unique_Values_Sheet_row_total = Unique_Values_Sheet.Cells(Rows.Count, "A").End(xlUp).Row
Dim Unqiue_Twitter_Names As Range
Set Unqiue_Twitter_Names = Unique_Values_Sheet.Range("A2:A" & Unique_Values_Sheet_row_total).Cells
For Each s In Sheets
If s.Name <> "UNIQUE_DATA" Then
row_total = s.Cells(Rows.Count, "B").End(xlUp).Row
For Each r In s.Range("B2:B" & row_total).Cells
Twitter_Name = r.Value
For Each c In Unqiue_Twitter_Names
If c.Value = Twitter_Name Then
With c
.Offset(0, 1).Value = CDbl(.Offset(0, 1).Value) + 1
.End(xlToRight).Offset(0, 1).Value = s.Name
End With
End If
Next
Next
End If
' Loop through first sheet
' Exit For
Next
With Application
.Calculation = xlCalculationAutomatic: .ScreenUpdating = True: .DisplayAlerts = True
End With
End Sub
尝试这个
Option Explicit
Sub CountInvestorsByTwitterName2()
Dim row_total As Long
Dim Unqiue_Twitter_Names As Range
Dim found As Range
Dim sht As Worksheet
Dim r As Range, shtRng As Range
With Application
.Calculation = xlCalculationManual: .ScreenUpdating = False: .DisplayAlerts = False
End With
With Sheets("UNIQUE_DATA")
.Columns("B:XFD").EntireColumn.Delete
Set Unqiue_Twitter_Names = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
End With
For Each sht In Sheets
With sht
If .Name <> "UNIQUE_DATA" Then
Set shtRng = .Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).SpecialCells(xlCellTypeConstants, xlTextValues)
For Each r In shtRng
Set found = Unqiue_Twitter_Names.Find(What:=r.Value, LookIn:=xlValues, LookAt:=xlWhole)
If Not found Is Nothing Then
With found
.Offset(0, 1).Value = CDbl(.Offset(0, 1).Value) + 1
.End(xlToRight).Offset(0, 1).Value = sht.Name
End With
End If
Next
End If
End With
Next
With Application
.Calculation = xlCalculationAutomatic: .ScreenUpdating = True: .DisplayAlerts = True
End With
End Sub
如果不够快,您可以尝试一些“数组”方法,将相关工作表单元格值存储在数组中并使用它们执行搜索
字典方法也值得研究
我会怎么做:
1) 清除整个“UNIQUE_DATA”表。
2)循环遍历所有工作表,如果工作表的名称不是'UNIQUE DATA',则将所有包含内容的行复制到'UNIQUE_DATA'(复制粘贴行,事先检测哪些行以及在哪些行插入它们)
3) 对包含 twitter 句柄的列上“唯一数据”中的所有行进行排序。 如果宏记录一次,宏代码很容易弄清楚。
4) 循环遍历“UNIQUE_DATA”表中的所有行,并将 Twitter 句柄的值与下面行的 Twitter 句柄进行比较。 如果它们匹配,则删除下一行(并降低循环计数器的上限)。
你应该得到所有独特的 Twitter 句柄。 我必须同意最后一步可能需要一些时间。 但至少这样做是 O(n) 的复杂性,而不是您目前使用两个嵌套循环的 O(n²)。 特别是对于高 n 值,时间差应该是显着的。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.