比较两列VBAmacros时，Excel崩溃
我有两列，我正在比较相同的条目，并通过偏移将比赛推到另一列。 当我运行我build立的macros（closures一些微软的固定代码），它基本上冻结和崩溃，因为它是基于所使用的单元格的每个循环嵌套，我认为它会到达一个空的单元格结束，但我担心我可能会陷入无限循环。 任何帮助都感激不尽。
Dim myRng As Range Dim lastCell As Long Dim lastRow As Long lastRow = ActiveSheet.UsedRange.Rows.Count Dim c As Range Dim d As Range For Each c In Worksheets("Sheet1").Range("AT2:AT" & lastRow).Cells For Each d In Worksheets("Sheet1").Range("AU2:AU" & lastRow).Cells If c = d Then c.Offset(0, 1) = c Next d Next c 尝试这个：
Dim lastRow, currentRow, compareRow As Long Dim found As Boolean lastRow = Range("AT2").End(xlDown).Row For currentRow = 2 To lastRow compareRow = 2 found = False Do While compareRow <= lastRow And Not found If Range("AT" & currentRow).Value = Range("AU" & compareRow).Value Then found = True Range("AV" & currentRow).Value = Range("AT" & currentRow).Value End If compareRow = compareRow + 1 DoEvents Loop Next currentRow
而不是select范围，然后循环通过它们，而不需要select任何东西。 如果发现匹配的话，它也会尽早地打开内部循环。
我相信这里有很多问题：
- search方法的效率
- Excel的响应丢失
如果可以将所有值拉入数组，则可以显着提高代码的效率。 这样可以防止VBA花费在访问Excel对象模型上的时间。 可以通过使用DoEvents来处理响应丢失。 尝试下面的代码。 它可能看起来很长，但应该很容易理解。
'Find last row Dim lastRow As Variant lastRow = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row 'Create dynamic arrays Dim AT() As Variant: Dim AU() As Variant: Dim AV() As Variant ReDim AT(2 To lastRow): ReDim AU(2 To lastRow): ReDim AV(2 To lastRow) 'Get all contents from Excel For i = 2 To lastRow AT(i) = Worksheets("Sheet1").Cells(i, 46) AU(i) = Worksheets("Sheet1").Cells(i, 47) Next i 'Do the comparison For c = 2 To lastRow For d = 2 To lastRow If AT(c) = AU(d) Then AV(c) = AT(c) Next d 'Allow a brief breather to Excel once in a while (don't hang) If (c / 100) = Int(c / 100) Then DoEvents Next c 'Place final contents to Excel For i = 2 To lastRow Worksheets("Sheet1").Cells(i, 48) = AV(i) Next i
试试你的循环：
Dim StartRange As Range, j As Long Dim CompareRange As Range, i As Range With Worksheets("Sheet1") Set StartRange = .Range("AT1", .Range("AT:AT").Find("*", , , , xlByRows, xlPrevious)) Set CompareRange = .Range("AU1", .Range("AU:AU").Find("*", , , , xlByRows, xlPrevious)) For Each i In StartRange i.Offset(, -8).Value = .Evaluate("IF(COUNTIF(" & CompareRange.Address(0, 0) & "," & i.Address(0, 0) & ")>0," & i.Value & ","""")") Next i End With
Dim CompareRange As Variant, To_Be_Compared As Variant, j As Variant, k As Variant Range("AT2").Select Selection.End(xlDown).Select Set To_Be_Compared = Range("AT2:" & Selection.Address) Range("AU2").Select Selection.End(xlDown).Select Set CompareRange = Range("AU2:" & Selection.Address) To_Be_Compared.Select For Each j In Selection DoEvents For Each k In CompareRange If j = k Then j.Offset(0, 2) = j Next k Next j
我终于明白了，在将这些build议和实现到我的代码后，我能够看到错误实际上是在哪里，我在代码的前面引用了错误的列，并且通过它创build了没有重复的条目来匹配，所以在解决这个问题之后，比赛现在出现了，我最终抵消了他们，把值改为“是”，以反映我图表中的重复。
谢谢大家的帮助。