循环通过两张 10000+ 行的更快方法

Question

此模块遍历工作表 2 中 a 列中的每个单元格，并检查工作表 2 中列 b 中的每个单元格，如果匹配，则“匹配数”增加并放置在工作表 3 中的单元格中。数据量很大，模块不断崩溃，是否有更好的方法（也许是访问，或更高效的 VBA 模块）。请注意，我需要知道每个单元格的匹配次数，而不是重复的总数。

提前谢谢各位！

Sub findpatterns()
Application.ScreenUpdating = False

Dim RowCount1 As Long, ClmnCount1 As Long
Dim RowCount2 As Long, ClmnCount2 As Long
Dim Crntrow As Long, Lastrow As Long
Dim Crntrow1 As Long, LastRow1 As Long
Dim Recordrow As Long
Recordrow = 1


    RowCount1 = Sheets("sheet1").Cells(Rows.Count, "a").End(xlUp).Row
    ClmnCount1 = Sheets("sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
    RowCount2 = Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row
    ClmnCount2 = Sheets("sheet2").Cells(1, Columns.Count).End(xlToLeft).Column

Lastrow = RowCount1
LastRow1 = RowCount2

Crntrow1 = 1
Crntrow = 1

 For Crntrow1 = 1 To LastRow1
'MsgBox "first loop is running"

For Crntrow = 1 To Lastrow
'MsgBox "second loop is running"
If (Sheets("sheet2").Cells(Crntrow1, "a").Value = Sheets("sheet1").Cells(Crntrow, "b").Value Or Sheets("sheet1").Cells(Crntrow, "b").Value = Sheets("sheet2").Cells(Crntrow1, "b").Value) And Not Sheets("sheet2").Cells(Crntrow1, "a").Value = "" Then

Sheets("sheet3").Cells(Crntrow1, "b").Value = Sheets("sheet3").Cells(Crntrow1, "b").Value + 1
'Sheets("sheet3").Cells(Crntrow1, "c").Value = Sheets("sheet2").Cells(Crntrow1, "g").Value
'MsgBox Material
Else
'MsgBox "no matches found"
End If
Next Crntrow

Next Crntrow1
End Sub

Answer 1

当您有这么大的数据并且它也有很多列时，您可能需要考虑使用数据库（MSAccess、SQLServer 等）。

也就是说，还有一些方法可以加快您的代码速度。 Excel 对象（如单元格、范围、表格等）包含您可能不需要的大小、颜色、边框、填充字体等数据。尝试使用变体来存储数据，如下所示：

让变量LastCol代表数据中的最后一列。

Dim myData as Variant
myData = Range(Sheets("Sheet2").Cells(1, 1), Sheets("Sheet2").Cells(LastRow, LastCol))

请注意，我没有使用 Set 关键字。这将返回 Range 对象的默认值（这是一个仅包含数据的变体。

现在迭代：For i = LBound(myData, 1) to UBound(MyData, 1) 应该更快。

Answer 2

首先在您的代码中添加几个 cmets，因为它并不容易阅读。

1. 你可以去掉一些变量，不使用 ClmnCount(1,2)
2. RowCount(1,2) 仅用于将值直接传递给 Lastrow，因此您实际上并不需要它们
3. 通过传递 RowCount1>LastRow 和 RowCount2>LastRow1，您可以尝试保持编号方案一致

看起来你基本上想要这样的 countif 语句

=IF(Sheet2!A1="",0,COUNTIF(Sheet1!$B$1:$B$10000,Sheet2!A1)+COUNTIF(Sheet1!$B$1:$B$10000,Sheet2!B1))

它计算 Sheet1 列 B 中与 sheet2 A1 或 B1 匹配的出现次数，并对第 2 列中的每一行执行此操作（只要 sheet2 A1 中有数据）。

通过在宏中使用此公式，您可以使用以下内容避免循环。它使用公式，为您需要的所有行填充它，然后将值复制到公式上以冻结它。这应该比你的双循环快一点。

Sub findpatterns()
Dim LastRow1 As Long
Dim LastRow2 As Long

Application.ScreenUpdating = False

LastRow1 = Sheets("sheet1").Cells(Rows.Count, "a").End(xlUp).Row
LastRow2 = Sheets("sheet2").Cells(Rows.Count, "a").End(xlUp).Row

Sheets("sheet3").Range("A1").Formula = "=IF(Sheet2!A1="""",0,COUNTIF(Sheet1!$B$1:$B$" & LastRow1 & ",Sheet2!A1)+COUNTIF(Sheet1!$B$1:$B$" & LastRow1 & ",Sheet2!B1))"
Sheets("sheet3").Range("A1").AutoFill Destination:=Sheets("sheet3").Range("A1:A" & LastRow2)

Calculate

Sheets("sheet3").Range("A1:A" & LastRow2).Value = Sheets("sheet3").Range("A1:A" & LastRow2).Value

Application.ScreenUpdating = True
End Sub