Question

如何解决Excel VBA中的Not Responding错误？

我的代码很完美，我没有收到任何错误但是在运行之后，我会看到NOT RESPONDING顶部的Excel VBA和Excel不再响应了。

我正在编写vba代码以查找两张纸之间的匹配数：Sheet1持有5000个数字，Sheet2持有4500个数字。当我运行它时，我的代码运行它10秒然后excel冻结我没有响应msg出现在屏幕的顶部。

现在，当我在两张纸之间仅比较100个数字，它的工作完美且不响应MSG不会出现时，它只会在我将10000个数字或更大数量的数字进行比较时发生。

再一次，这个代码工作得很完美，当我只比较100个数字，但是当我尝试在两张纸之间做更大的数字时，没有回应出现在我身上的EXGREL冻结....这是我的代码我想尝试筛选或其他活动，无需帮助......如果有人帮助我，我将非常感激。感谢

     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

Answer 1

这是一段非常低效的代码。所以它会停留在更长时间的操作上。

理想情况下，您应该使用

完全重写它

VariantVariable = RangeVariable

然后反过来将数据放回到工作表上（从而最小化代码访问电子表格的次数），现在的一些快速修复包括：

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

' Your code goes here

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

这可能有助于加快速度。

建议的算法（伪代码）：如果您要做的是比较工作表1和工作表2中的列，然后将匹配数字复制到工作表3，那么您正在做的事情充其量只有O （n ^ 2）复杂性，并且可以轻松地查看实现。在任何一种情况下，这里都是关于你如何进行的伪代码。

假设两列都有'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

假设Quicksort用于排序，我们讨论的是O（n log n）用于平均排序和O（n）用于合并连接过滤。

然后我将我的排序数组存储为其他地方的缓存列，以便所有进一步的操作都将在O（n）中进行。为什么这样好？有几个原因。

这可能不是最有效的方法，但肯定胜过O（n ^ 2）。
给你一种比较感。如果您当前的系统需要1秒钟来完成每个长度为100个元素的列，则需要11天以上才能完成两列100,000个元素。
同样，如果预先排序后的上述系统在100个元素上需要1秒钟，那么100,000个元素只需要16分钟以上。

正如评论中所提到的，你可以优化来自bubblesort的生活日光，但是......

修改：在此页面上有关算法的更多讨论：How to intersect two sorted integer arrays without duplicates?

Answer 2

您已经获得了一些非常出色的答案，可以让您的代码更好。我只想补充一点。

如果您只想让程序免于冻结，请添加

DoEvents

在每个循环中自己的行。

我还建议添加

Application.StatusBar = "Updating" & (i)

这样你至少可以看看它是否有效。

Answer 3

此答案假设您在Sheet1上有一个免费列。对于这个答案，我假设空列是B。

在B1中：

=COUNTIFS(Sheet2!A:A,Sheet1!A1)

然后将其向下拖动到Sheet1中包含A列条目的所有行。例如，单元格B1234将具有：

=COUNTIFS(Sheet2!A:A,Sheet1!A1234)

然后你只需编写一个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

应该比你的代码更快地工作。当然，您希望包含hnk建议的前缀和后缀。

你总是可以写一些VBA来列＃34; B＆＃34;在那里，然后在完成后将其删除。

Answer 4

根据我的经验，最快的解决方案是将数据从Excel工作表中移出（而不是从Excel中移出）。将所有数据复制到数组中，然后比较数组值。 Mr.Excel，Ozgrid和Stackoverflow有关于如何将Ranges移动到阵列的所有文档。

搜索查询：“excel vba copy range to array stackoverflow”

结果：Excel VBA Copying range values to an Array,

我在不到2秒的时间内处理了20,000行。您的结果可能会因您执行的数学/比较而有所不同。您可以将结果放在另一个数组中，并将该数组插入Excel工作表（最快）或直接从比较中更新工作表。

Answer 5

我正在使用简单的技巧。如果我的脚本有一些循环，则每个X ^th循环都要调用此例程，这总是有帮助的。

呼叫睡眠（1）

#from Tkinter import *
from Tkinter import Tk, Text, Frame, Scrollbar, END
import time



# while True:
#     ROOT.update()
# 
#     time.sleep(10)
#     txt.insert(END, "hello here\n")
#     txt.pack()    


import threading
class ThreadingExample(object):
    """ Threading example class
    The run() method will be started and it will run in the background
    until the application exits.
    """

    def __init__(self, interval=1):
        """ Constructor
        :type interval: int
        :param interval: Check interval, in seconds
        """
        self.interval = interval

        thread = threading.Thread(target=self.run, args=())
        thread.daemon = True                            # Daemonize thread
        thread.start()                                  # Start the execution

    def run(self):
        """ Method that runs forever """
        time.sleep(1)
        global ROOT
        while True:
            ROOT.update()

            time.sleep(2)
            txt.insert(END, "hello here\n")
            txt.pack()   

            print "aa" 




global ROOT
ROOT = Tk()
# create a Frame for the Text and Scrollbar
txt_frm = Frame(ROOT, width=600, height=600)
txt_frm.pack(fill="both", expand=True)
# ensure a consistent GUI size
txt_frm.grid_propagate(False)
# implement stretchability
txt_frm.grid_rowconfigure(0, weight=1)
txt_frm.grid_columnconfigure(0, weight=1)
# create a Text widget
txt = Text(txt_frm, borderwidth=3, relief="sunken")
txt.config(font=("consolas", 12), undo=True, wrap='word')
txt.grid(row=0, column=0, sticky="nsew", padx=2, pady=2)
# create a Scrollbar and associate it with txt
scrollb = Scrollbar(txt_frm, command=txt.yview)
scrollb.grid(row=0, column=1, sticky='nsew')
txt['yscrollcommand'] = scrollb.set
txt.insert(END, "hello\n")
txt.pack()

example = ThreadingExample()

我如何在vba中修复NOT RESPONDING

5 个答案: