更快的方式来循环两行10000+行

这个模块遍历表2中列a中的每个单元格，并且与sheet2中colmumn b中的每个单元格进行核对，如果它匹配“matches number”增加并放置在单元格im sheet3中。 数据量巨大，模块不断崩溃，有没有这样做（也许访问，或更有效的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

首先closures你的代码的一些评论，因为这是不容易阅读的。

1. 你可以去掉一些variables，ClmnCount（1,2）不被使用
2. RowCount（1,2）仅用于将值直接传递给Lastrow，因此您并不需要它们
3. 通过传递RowCount1> LastRow和RowCount2> LastRow1你让它更混乱尽量保持你的编号scheme一致

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

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

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

通过在macros中使用这个公式，你可以避免使用类似下面的东西。 它使用公式，填充所有你需要的行，然后复制公式的值来冻结它。 这应该是一个快一点，那么你的双循环。

 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 

Answer 2

当你有这么大的数据，如果它也有很多列，你可能要考虑使用数据库（MSAccess，SQLServer等）。

也就是说，还有一些方法可以加速你的代码。 像单元格，范围，表格等Excel对象是沉重的大小，颜色，边界，填充字体等，你不可能需要的数据。 尝试使用一个变体来存储数据，就像这样：

让variablesLastCol表示数据中的最后一列。

 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)应该更快。