Question

该模块遍历工作表2中列a中的每个单元格，并检查它与sheet2中colmumn b中的每个单元格，如果它匹配＆＃34;匹配数字＆＃34;增加并放置在单元格中。数据量巨大且模块不断崩溃，是否有更好的方法（可能是访问，或更高效的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

首先关闭一些关于代码的评论，因为它不容易阅读。

你可以摆脱一些变量，ClmnCount（1,2）没有被使用
RowCount（1,2）仅用于将值直接传递给Lastrow，因此您并不真正需要它们
通过传递RowCount1＆gt; LastRow和RowCount2＆gt; 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

更快的方式循环两张10000多行

2 个答案: