Question

我使用以下功能将文件读入电子表格。我想添加一个停止按钮（something like this），但问题是，当它运行时，它完全锁定Excel，我无法以任何方式与它交互。有没有办法优雅地阻止这样的事情？请注意，这些是巨大的文件（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

首先，关闭屏幕刷新和计算。

Application.ScreenUpdating = False
Application.Calculation = xlManual

然后在最后，重新开启

Application.ScreenUpdating = True
Application.Calculation = XlCalculationAutomatic

另外，如果你添加某种类型的计数器，在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或其他的偶数除数。

另外，是加载＆＃34;动画＆＃34;需要？我敢打赌，当跑过那么多牢房时，它会花费很长时间。而且，想到这一点，当你关闭屏幕更新时，你不会看到那个动画，所以可能会注释掉它并看看它是如何运行的。

Answer 2

为了让excel不要'锁定'，你必须调用'DoEvents'。使用以下内容也可以加快您的流程，但是看起来好像您需要更新屏幕以更新状态栏，而EnableEvents则需要操作按钮按下事件。

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

如果您愿意，可以使用最底层的应用程序状态栏：

Application.StatusBar = "Your Value Here"

请务必在离开功能前清除它。如果您想要真正'安全'，您可以在写入之前存储其旧的先前值，然后在此处恢复。

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

停止密集文件进程？

3 个答案: