VBA优化宏循环

Question

场景是我有40张工作表，每张工作表中最多可以有5k行，所以我要处理大量数据，这导致这个宏运行速度非常慢。例如，仅第一片材就具有大约15219162个计算，其仅具有大约380行。有没有办法减少我的宏必须运行的计算量？

到目前为止，共有39326个unqiue推特名称，即第一页中的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

Answer 1

尝试这个

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

如果速度不够快，可以尝试一些"数组"方法，将相关的单元格值存储在数组中，并使用它们进行搜索

此外，Dictionary方法可能值得检查

Answer 2

我会做什么：

1） 清除整个"UNIQUE_DATA"工作表
2） 循环浏览所有工作表，如果工作表的名称不是"UNIQUE DATA"，则将所有包含内容的行复制到"UNIQUE_DATA"（在事先检测到要插入的行和行之后，复制粘贴行）
3） 对包含twitter句柄的列上"UNIQUE DATA"中的所有行进行排序。如果宏记录一次，宏代码很容易理解
4） 循环遍历工作表"UNIQUE_DATA"中的所有行，并将Twitter句柄的值和下面行的Twitter句柄进行比较。如果匹配，则删除下一行（并降低循环计数器的上限）。

你最终应该拥有所有独特的Twitter句柄。我不得不同意最后一步可能需要一些时间。但至少这样做是O（n）的复杂性，而不是目前具有两个嵌套循环的O（n²）。特别是对于n的高值，时间差应该是显著的。