我如何在 vba 中修复 NOT RESPONDING
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/24621976/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
how do i fix NOT RESPONDING in vba
提问by user3795861
How do i fix the Not Respondingerror in Excel VBA?
如何修复Not RespondingExcel VBA 中的错误？
My code is perfect, I'm not getting any error but after I run it, I will see NOT RESPONDINGtop of Excel VBA and Excel doesn't respond anymore.
我的代码是完美的，我没有收到任何错误，但是在我运行它之后，我会看到NOT RESPONDINGExcel VBA 的顶部并且 Excel 不再响应。
I am writing vba code to find the match numbers between two sheets: Sheet1holding 5000 numbers and Sheet2holding 4500 numbers. When i run it , my code run it for 10 secs then excel freezing on me and not responding msg appear top of the screen.
我正在编写 vba 代码来查找两张纸之间的匹配号码：Sheet1持有 5000 个号码和Sheet2持有 4500 个号码。当我运行它时，我的代码运行了 10 秒，然后 excel 冻结在我身上并且没有响应 msg 出现在屏幕顶部。
NOW WHEN I COMPARE ONLY 100 NUMBERS BETWEEN TWO SHEETS, ITS WORK PERFECT AND NOT RESPONDING MSG DOESN'T APPEAR, it only occurs when I compare 10000 numbers together or larger amount of numbers.
现在，当我只比较两张纸之间的 100 个数字时，它的工作完美且不响应 MSG 不会出现，只有当我将 10000 个数字或更多数字进行比较时才会出现这种情况。
Once again this code is working perfectly, when i am comparing only 100 numbers but when i try to do larger numbers between two sheets, NOT RESPONDING APPEAR AND EXCEL FREEZING ON ME.... Here is my code AND I DID TRY SCREENUPDATE OR OTHER DO EVENTS, DOESNT HELP... I will really appreciate, if someone help me out. Thanks
再一次，这段代码运行良好，当我只比较 100 个数字但当我尝试在两张纸之间做更大的数字时，不响应出现和 EXCEL 冻结我......这是我的代码，我尝试了屏幕更新或其他做活动，没有帮助......如果有人帮助我，我会非常感激。谢谢
Dim Sheet1rows As Long, Sheet2rows As Long, a as long, j as long
j = 1
a = 1
Sheet1rows = Sheets("Sheet1").UsedRange.Rows.Count + 1
Sheet2rows = Sheets("Sheet2").UsedRange.Rows.Count + 1
For i = a To Sheet1rows
For ii = a To Sheet2rows
'this one is copying between to sheets
If Sheets("Sheet1").Cells(i, 1) = Sheets("Sheet2").Cells(ii, 1) Then
Sheets("Sheet3").Range("A" & j) = Sheets("Sheet1").Cells(i, 1)
j = j + 1
next ii
next i
回答by Tanner
You've gotten some pretty stellar answers to make your code better already. I just want to add one thing.
您已经得到了一些非常出色的答案，可以让您的代码变得更好。我只想补充一件事。
If you just want to keep the program from FREEZING, then add
如果您只想防止程序冻结，请添加
DoEvents
inside each loop on its own line.
在它自己的行上的每个循环内。
I'd also suggest adding
我还建议添加
Application.StatusBar = "Updating" & (i)
so that you can at least see if it is working.
这样您至少可以看到它是否有效。
回答by hnk
This is a terribly inefficient piece of code. So it's getting stuck on longer operations.
这是一段非常低效的代码。所以它被困在更长的操作上。
While ideally you should rewrite it completely using
理想情况下，您应该使用完全重写它
VariantVariable = RangeVariable
and then doing the opposite to put data back onto the sheet (and hence minimizing the number of times your code accesses the spreadsheet), a few quick fixes for now would include:
然后以相反的方式将数据放回工作表（从而最大限度地减少代码访问电子表格的次数），目前的一些快速修复包括：
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
' Your code goes here
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
This might help speed things up a bit.
这可能有助于加快速度。
Proposed algo (pseudocode):If what you are looking to do is Compare columns in Sheet 1 and Sheet 2 and then Copy the Matching numbers to Sheet 3, you are doing something that's at best O(n^2) in complexity, and looking at the implementation could easily be even more. In either case, here is the pseudocode on how you may proceed.
建议的算法（伪代码）：如果您要做的是比较工作表 1 和工作表 2 中的列，然后将匹配的数字复制到工作表 3，那么您所做的事情的复杂性至多为 O(n^2)，并且正在寻找在实施中很容易甚至更多。无论哪种情况，这里都是关于如何进行的伪代码。
Assume both columns have 'n' elements.
假设两列都有“n”个元素。
Dim LHS as Variant, RHS as Variant
LHS = RangeOfColumnInSheet1
RHS = RangeOfColumnInSheet2
Sort -> LHS
Sort -> RHS
' You may use dictionary structures if you please
Merge Join -> LHS + RHS ------> MergedList
Scan(MergedList) to find out non-matching numbers -> UniqueList
OutputRange = UniqueList
Assuming Quicksort for sorting, we are talking of O(n log n) for sorting on average and O(n) for merge-join-filtering.
假设使用 Quicksort 进行排序，我们讨论的是 O(n log n) 用于平均排序，O(n) 用于合并连接过滤。
Then I would store my sorted arrays as cached columns elsewhere so that all further operations will take place in O(n). Why is this good? For several reasons.
然后我将我的排序数组作为缓存列存储在其他地方，以便所有进一步的操作都将在 O(n) 中进行。为什么这很好？有几个原因。
this might not be the most efficient way to go about it, but it sure beats O(n^2).
To give you a sense of comparison. If your current system is taking 1 second to go through columns of length 100 elements each, it will take 11+ days to go through two columns of 100,000 elements each.
Similarly, if the proposed system above after pre-sorting takes 1 second for 100 elements, it'll only take about 16+ minutes for 100,000 elements.
这可能不是最有效的方法，但它确实胜过 O(n^2)。
给你一个比较的感觉。如果您当前的系统需要 1 秒来浏览每列长度为 100 个元素的列，那么浏览两列每列 100,000 个元素将需要 11 天多的时间。
同样，如果上述建议的系统在预排序后对 100 个元素需要 1 秒，那么对 100,000 个元素只需要大约 16 分钟以上。
As mentioned in the comment, you can optimize the living daylights out of bubblesort, but...
正如评论中提到的，您可以通过气泡排序优化生活日光，但是......
Edit: More discussion on the algo on this page: How to intersect two sorted integer arrays without duplicates?
编辑：关于本页算法的更多讨论：如何将两个排序的整数数组相交而没有重复？
回答by BeaumontTaz
This answer assumes that you have a free column on Sheet1. For this answer I'll assume that empty column is B.
此答案假定您在 Sheet1 上有一个空闲列。对于这个答案，我假设空列是 B。
In B1 put:
在 B1 中输入：
=COUNTIFS(Sheet2!A:A,Sheet1!A1)
And then drag it down through all rows in Sheet1 that have entries in column A. For example, cell B1234 would have:
然后将它向下拖动到 Sheet1 中在 A 列中有条目的所有行。例如，单元格 B1234 将具有：
=COUNTIFS(Sheet2!A:A,Sheet1!A1234)
Then you just have to write a VBA code to copy the entires that come up with something other than a 0.
然后你只需要编写一个 VBA 代码来复制除 0 以外的所有内容。
Dim lastrow As Long, j As Long
lastrow = Worksheets("Sheet1").UsedRange.Rows.Count + 1
j = 1
For i = 1 To lastrow
If Worksheets("Sheet1").Cells(i, 2) <> 0 Then
Worksheets("Sheet3").Cells(j, 1) = Worksheets("Sheet1").Cells(i, 1)
j = j + 1
End If
Next i
Should work MUCH faster than you code. Of course you'd want to include the prefix and suffix suggested by hnk.
应该比你的代码工作得快得多。当然，您希望包含 hnk 建议的前缀和后缀。
And you could always write some VBA to put column "B" in there and then remove it when it's done.
而且您总是可以编写一些 VBA 将列“B”放在那里，然后在完成后将其删除。
回答by Jim
The fastest solution based on my experience is to move the data out of Excel worksheets (not out of Excel). Copy all data into arrays and then compare the array values. Mr.Excel, Ozgrid and Stackoverflow have all the documentation on how to move Ranges into Arrays.
根据我的经验，最快的解决方案是将数据移出 Excel 工作表（而不是移出 Excel）。将所有数据复制到数组中，然后比较数组值。Mr.Excel、Ozgrid 和 Stackoverflow 有关于如何将范围移动到数组的所有文档。
Search query: "excel vba copy range to array stackoverflow"
搜索查询：“excel vba copy range to array stackoverflow”
Result: Excel VBA Copying range values to an Array,
I've dealt with 20,000 rows in less than 2 seconds. Your results may vary based on the math/comparisons you perform. You can place the results in another array and insert that array into Excel worksheet (fastest) or update the worksheet directly from the comparison.
我在不到 2 秒的时间内处理了 20,000 行。您的结果可能会根据您执行的数学/比较而有所不同。您可以将结果放在另一个数组中，然后将该数组插入 Excel 工作表（最快）或直接从比较中更新工作表。
回答by Ladislav Florián
I'm using simple hack. If my script has some cycles I call this routine each Xthcycle, that allways helps.
我正在使用简单的黑客。如果我的脚本有一些循环，我会在每个第X个循环中调用这个例程，这总是有帮助的。
Call Sleep(1)
呼叫睡眠(1)
Sub Sleep(Sec)
Dim S as Object: Set S = CreateObject("WScript.Shell")
S.Run "cmd /c ping localhost -n " & Sec, 0, True End Sub
