VBA优化macros循环
这个场景是我有40张纸，每张纸上最多可以有5k行，所以我正在处理大量导致这个macros运行非常慢的数据。 例如，第一张纸单独有大约15219162个计算，其中只有大约380行。 有没有办法削减我的macros必须运行的计算量？
到目前为止，有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
如果速度不够快，可以尝试一些“数组”方法，将相关的单元格值存储在数组中，并使用它们进行search
字典的方法也值得检查
我会做什么：
1）清除整个'UNIQUE_DATA'表。
2）循环遍历所有工作表，如果工作表的名称不是“UNIQUE DATA”，则将所有包含内容的行复制到“UNIQUE_DATA”（复制粘贴行，事先检测到哪些行以及要插入哪些行）
3）在包含twitter句柄的列的“UNIQUE DATA”中对所有行进行sorting。 macros代码很容易弄清楚，如果你一次macroslogging。
4）遍历工作表“UNIQUE_DATA”中的所有行，并将Twitter句柄的值与下面一行的Twitter句柄进行比较。 如果它们匹配，则删除下一行（并降低循环计数器的上限）。
你应该结束所有独特的Twitter手柄。 我不得不同意，最后一步可能需要一些时间。 但至less这样做是复杂的O（n），而不是O（n²）你现在有两个嵌套循环。 特别是对于n的高值，时间差异应该是显着的。