停止密集的文件处理？

我正在使用以下函数将文件读入电子表格。 我正在考虑添加一个停止button（ 类似这样的 ），但问题是，这是运行时，它完全lockingExcel，我不能以任何方式进行交互。 有没有办法优雅地阻止这样的事情？ 请注意，这些是巨大的文件（500,000多行）

Function LoadFile(m) Dim WrdArray() As String Dim txtstrm As TextStream Dim line As String Dim clm As Long Dim Rw As Long Dim Dash As Worksheet Set Dash = Sheets("Dashboard") Set cellStatus = Dash.Range("E3") Set txtstrm = FSO.OpenTextFile("s:\views_" & m & ".txt") Rw = 1 Do Until txtstrm.AtEndOfStream If Rw Mod 4 = 0 Then cellStatus.Value = "Loading " & m & "... /" If Rw Mod 4 = 1 Then cellStatus.Value = "Loading " & m & "... |" If Rw Mod 4 = 2 Then cellStatus.Value = "Loading " & m & "... \" If Rw Mod 4 = 3 Then cellStatus.Value = "Loading " & m & "... -" line = txtstrm.ReadLine clm = 1 WrdArray() = Split(line, "|!|") For Each wrd In WrdArray() Sheets(m).Cells(Rw, clm) = wrd clm = clm + 1 Next wrd Rw = Rw + 1 Loop txtstrm.Close LoadFile = Rw End Function 

Answer 1

首先，closures屏幕刷新和计算。

 Application.ScreenUpdating = False Application.Calculation = xlManual 

然后在最后，再打开

 Application.ScreenUpdating = True Application.Calculation = XlCalculationAutomatic 

另外，如果你添加一些types的计数器，在X迭代之后，提示用户继续或不继续，像

 Dim myCount as Long ...your loop starts here myCount = myCount + 1 If myCount mod 1000 = 0 then toContinue = msgBox("Continue with macro?",vbYesNo) If toContinue = vbNo then exit sub End if ...continue loop 

编辑：嗯，我将不得不调整， If myCount mod 1000 = 0更好的东西…基本上是甚至1000的东西除数。

另外，是否需要加载“animation”？ 我敢打赌，这在很多细胞上运行时都会花费很长时间。 而且，想到这一点，当你closuresscreenupdating，你不会看到这个animation，所以也许注释掉，看看它是如何运行的。

Answer 2

为了不让excel“locking”，你必须调用“DoEvents”。 使用以下步骤也将加速您的stream程，但看起来您需要使用屏幕更新来更新状态栏，并使用EnableEvents来操作button按下事件。

 Application.ScreenUpdating = False Application.Calculation = xlManual Application.EnableEvents = False 

如果需要，可以在最下面使用应用程序的状态栏：

 Application.StatusBar = "Your Value Here" 

在离开你的function之前，请确保清除它。 如果你想成为真正的'安全'，你可以在写入之前保存旧的值，然后在这里恢复。

 Application.StatusBar = "" 

您的修改代码如下：

 Function LoadFile(m) Dim WrdArray() As String Dim txtstrm As TextStream Dim line As String Dim clm As Long Dim Rw As Long Dim Dash As Worksheet Application.Calculation = xlManual Set Dash = Sheets("Dashboard") Set cellStatus = Dash.Range("E3") Set txtstrm = FSO.OpenTextFile("s:\views_" & m & ".txt") Rw = 1 Do Until txtstrm.AtEndOfStream If Rw Mod 4 = 0 Then Application.StatusBar = "Loading " & m & "... /" If Rw Mod 4 = 1 Then Application.StatusBar = "Loading " & m & "... |" If Rw Mod 4 = 2 Then Application.StatusBar = "Loading " & m & "... \" If Rw Mod 4 = 3 Then Application.StatusBar = "Loading " & m & "... -" line = txtstrm.ReadLine clm = 1 WrdArray() = Split(line, "|!|") For Each wrd In WrdArray() Sheets(m).Cells(Rw, clm) = wrd clm = clm + 1 Next wrd Rw = Rw + 1 'This will insure that excel doesn't lock up or freeze DoEvents Loop txtstrm.Close LoadFile = Rw Application.Calculation = XlCalculationAutomatic Application.StatusBar = "" End Function 

Answer 3

不知道为什么你在一个函数中这样做，但是如果你有Sub来调用它，那么暂停计算可能会更好。

无论如何，试试这个（一次性转储数组值）：

 Function LoadFile(m) Dim WrdArray() As String Dim txtstrm As Object Dim line As String Dim clm As Long ' Now used as number of items in the Split Dim CalcMode As Long Dim Rw As Long Dim Dash As Worksheet Set Dash = Sheets("Dashboard") 'Set cellStatus = Dash.Range("E3") Set txtstrm = FSO.OpenTextFile("s:\views_" & m & ".txt") Rw = 1 CalcMode = Application.Calculation ' Save calculation mode Application.Calculation = xlCalculationManual ' Change to Manual Calculation Do Until txtstrm.AtEndOfStream Application.StatusBar = Now & ": Loading " & m & " (Rw: " & Rw & ")" 'If Rw Mod 4 = 0 Then cellStatus.Value = "Loading " & m & "... /" 'If Rw Mod 4 = 1 Then cellStatus.Value = "Loading " & m & "... |" 'If Rw Mod 4 = 2 Then cellStatus.Value = "Loading " & m & "... \" 'If Rw Mod 4 = 3 Then cellStatus.Value = "Loading " & m & "... -" line = txtstrm.ReadLine 'clm = 1 WrdArray = Split(line, "|!|") clm = UBound(WrdArray) + 1 ' Number of items in the split ' Dump the array to cells value to resized range from Col A Sheets(m).Cells(Rw, "A").Resize(, clm).Value = WrdArray 'For Each wrd In WrdArray() ' Sheets(m).Cells(Rw, clm) = wrd ' clm = clm + 1 'Next wrd Rw = Rw + 1 Loop txtstrm.Close Application.StatusBar = False ' Reset status bar Application.Calculation = CalcMode ' restore calculation mode LoadFile = Rw End Function