几千行数据后效率低下的excel代码中断

Question

我对 Excel 和 VBA 还很陌生。我编写了一个代码，将一行数据分成多个部分，然后添加标题、颜色和图表。

问题是当我有很多行数据时。当我有大约 4000 行数据时，我的代码运行得很好，但是我说大约 10000 行，Excel 冻结并且不再响应。代码相当长，我希望任何人都能阅读整个内容。

我怀疑 excel 没有响应并崩溃，因为有一个看门狗计时器可以计时代码的执行，如果它没有收到任何返回，那么它就会崩溃。这只是一个猜测。

这是我需要过滤的几行实际数据以及所有内容。

2017:06:29T14:12:11,0,1013,00,156,-0.112,12.751,000,000,38,34,33,1014,00,202,-0.102,12.734,000,000,38,35,33,1015,00,174,-0.105,12.755,000,000,37,35,33,1008,00,156,-0.110,12.741,000,000,37,35,33,
2017:06:29T14:12:12,0,1013,00,157,-0.102,12.758,000,000,38,34,33,1014,00,203,-0.105,12.744,000,000,38,35,33,1015,00,175,-0.103,12.757,000,000,37,35,33,1008,00,157,-0.107,12.757,000,000,37,35,33,
2017:06:29T14:12:13,0,1013,00,158,-0.113,12.737,000,000,38,34,33,1014,00,204,-0.094,12.760,000,000,38,35,33,1015,00,176,-0.117,12.748,000,000,37,35,33,1008,00,158,-0.109,12.744,000,000,37,35,33,
2017:06:29T14:12:14,0,1013,00,159,-0.103,12.753,000,000,38,34,33,1014,00,205,-0.103,12.720,000,000,38,35,33,1015,00,177,-0.108,12.732,000,000,37,35,33,1008,00,159,-0.110,12.758,000,000,37,35,33,
2017:06:29T14:12:15,0,1013,00,160,-0.112,12.757,000,000,38,34,33,1014,00,206,-0.095,12.734,000,000,38,35,33,1015,00,178,-0.118,12.729,000,000,37,35,33,1008,00,160,-0.115,12.755,000,000,37,35,33,

我愿意接受任何建议，并且非常乐意学习。提前感谢您的时间和帮助。

Sub SeparateData()
'Author:    Me
'Date:      July 13, 2017
'Purpose:   This macro take the data in the worksheet and separates the data in a readable fashion for the user.
'           This macro also plots and reports any errors that it has caught both in separate sheets named accordingly.

'Define variables
Dim i As Variant
Dim j As Variant
Dim k As Variant
Dim data As Variant
Dim data2 As Variant
Dim count As Variant
Dim shiftDown As Variant
Dim monitorNum As Variant
Dim errorCount As Variant
Dim battChart As ChartObject
Dim currChart As ChartObject
Dim tempChart As ChartObject


'Stop the alerts so we can erase the sheets peacefully
Application.DisplayAlerts = False
'Erase the extra sheets
Sheets("Sheet2").Delete
Sheets("Sheet3").Delete
'Turn on the alerts in case something else happened
Application.DisplayAlerts = True

'Rename the first sheet
ActiveSheet.Name = "Data"
'Create a new sheet for the plots
Sheets.Add.Name = "Plots"
'Create a new sheet for the errors
Sheets.Add.Name = "Errors"

'Activate the first sheet for data processing
Worksheets("Data").Activate

'Enter the number of monitors
monitorNum = 4

'Variable to shift down the data so that te headers will fit (recommended 2)
shiftDown = 2

'Variable to count the number of errors the program thinks occured
errorCount = 0

'Count how many data point there are in the sheet
count = Cells(1, 1).CurrentRegion.Rows.count

'Iterate through the points separating the Data
For i = 0 To count - 1
    'First separate the date from the rest
    data = Cells(count - i, 1).Value
    data = Split(data, "T")
    For j = 0 To UBound(data)
        Cells(count - i + shiftDown, j + 1).Value = data(j)
    Next j
    'Now separate the rest of the data
    data2 = data(1)
    data2 = Split(data2, ",")
    For j = 0 To UBound(data2)
        Cells(count - i + shiftDown, j + 2).Value = data2(j)
    Next j
    For k = 0 To monitorNum - 1
        'Check for voltage error
        If Cells(count - i + shiftDown, (k * 10) + 8).Value > 20 Or IsNumeric(Cells(count - i + shiftDown, (k * 10) + 8).Value) = False Then
            'increment the number of errors found
            errorCount = errorCount + 1
            'Activate the Errors sheet for error recording
            Worksheets("Errors").Activate
            'Save the row number and the monitor number where the error was founf
            Cells(errorCount, 1).Value = "Voltage error in row"
            Cells(errorCount, 2).Value = count - i + shiftDown
            Cells(errorCount, 3).Value = "in column"
            Cells(errorCount, 4).Value = (k * 10) + 8
            Cells(errorCount, 5).Value = "in Monitor"
            Cells(errorCount, 6).Value = k + 1
            Cells(errorCount, 7).Value = "The recorded data was"
            Sheets("Data").Cells(count - i + shiftDown, (k * 10) + 8).Copy Cells(errorCount, 8)
            'Autofit all the columns
            Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
            'Activate the first sheet for data processing
            Worksheets("Data").Activate
            'Clear the contents of the error
            Cells(count - i + shiftDown, (k * 10) + 8).ClearContents
        End If

        'Check for current error
        If Cells(count - i + shiftDown, (k * 10) + 7).Value > 80 Or IsNumeric(Cells(count - i + shiftDown, (k * 10) + 7).Value) = False Then
            'increment the number of errors found
            errorCount = errorCount + 1
            'Activate the Errors sheet for error recording
            Worksheets("Errors").Activate
            'Save the row number and the monitor number where the error was founf
            Cells(errorCount, 1).Value = "Current error in row"
            Cells(errorCount, 2).Value = count - i + shiftDown
            Cells(errorCount, 3).Value = "in column"
            Cells(errorCount, 4).Value = (k * 10) + 7
            Cells(errorCount, 5).Value = "in Monitor"
            Cells(errorCount, 6).Value = k + 1
            Cells(errorCount, 7).Value = "The recorded data was"
            Sheets("Data").Cells(count - i + shiftDown, (k * 10) + 7).Copy Cells(errorCount, 8)
            'Autofit all the columns
            Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
            'Activate the first sheet for data processing
            Worksheets("Data").Activate
            'Clear the contents of the error
            Cells(count - i + shiftDown, (k * 10) + 7).ClearContents
        End If

        'Check for temperature error
        If Cells(count - i + shiftDown, (k * 10) + 13).Value > 80 Or IsNumeric(Cells(count - i + shiftDown, (k * 10) + 13).Value) = False Then
            'increment the number of errors found
            errorCount = errorCount + 1
            'Activate the Errors sheet for error recording
            Worksheets("Errors").Activate
            'Save the row number and the monitor number where the error was founf
            Cells(errorCount, 1).Value = "Temperature error in row"
            Cells(errorCount, 2).Value = count - i + shiftDown
            Cells(errorCount, 3).Value = "in column"
            Cells(errorCount, 4).Value = (k * 10) + 13
            Cells(errorCount, 5).Value = "in Monitor"
            Cells(errorCount, 6).Value = k + 1
            Cells(errorCount, 7).Value = "The recorded data was"
            Sheets("Data").Cells(count - i + shiftDown, (k * 10) + 13).Copy Cells(errorCount, 8)
            'Autofit all the columns
            Cells(1, 1).CurrentRegion.EntireColumn.AutoFit
            'Activate the first sheet for data processing
            Worksheets("Data").Activate
            'Clear the contents of the error
            Cells(count - i + shiftDown, (k * 10) + 13).ClearContents
        End If
    Next k
Next i

'Erase the data that has been duplicated
For i = 1 To shiftDown
    Cells(i, 1).Value = ""
Next i

'Write and color the headers
'For the Date
Range(Cells(shiftDown - 1, 1), Cells(shiftDown, 1)).Merge
Range(Cells(shiftDown - 1, 1), Cells(shiftDown, 1)).Value = "Date"
Range(Cells(shiftDown - 1, 1), Cells(count + shiftDown, 1)).Interior.Color = RGB(200, 190, 150)
'For the Time
Range(Cells(shiftDown - 1, 2), Cells(shiftDown, 2)).Merge
Range(Cells(shiftDown - 1, 2), Cells(shiftDown, 2)).Value = "Time"
Range(Cells(shiftDown - 1, 2), Cells(count + shiftDown, 2)).Interior.Color = RGB(150, 140, 80)
'For the Key Switch
Range(Cells(shiftDown - 1, 3), Cells(shiftDown, 3)).Merge
Range(Cells(shiftDown - 1, 3), Cells(shiftDown, 3)).Value = "Key Switch"
Range(Cells(shiftDown - 1, 3), Cells(count + shiftDown, 3)).Interior.Color = RGB(200, 200, 0)

For i = 1 To monitorNum
    Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Merge
    Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Value = "Monitor " & i
    'color the headers
    If i Mod 4 = 0 Then
        Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Interior.Color = RGB(100, 255, 100)
    ElseIf i Mod 3 = 0 Then
        Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Interior.Color = RGB(255, 100, 10)
    ElseIf i Mod 2 = 0 Then
        Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Interior.Color = RGB(100, 100, 255)
    Else
        Range(Cells(shiftDown - 1, ((i - 1) * 10) + 4), Cells(shiftDown - 1, (i * 10) + 3)).Interior.Color = RGB(255, 75, 75)
    End If
Next i

For i = 0 To monitorNum - 1
    'Monitor ID
    Cells(shiftDown, 1 + (i * 10) + 3).Value = "MONITOR_NUM"
    'Monitor status
    Cells(shiftDown, 2 + (i * 10) + 3).Value = "MONITOR_STATUS"
    'Heart Beat count
    Cells(shiftDown, 3 + (i * 10) + 3).Value = "HB_COUNT"
    'For Current
    Cells(shiftDown, 4 + (i * 10) + 3).Value = "CURRENT"
    Range(Cells(shiftDown, 4 + (i * 10) + 3), Cells(count + shiftDown, 4 + (i * 10) + 3)).Interior.Color = RGB(240, 150, 150)
    'For Voltage
    Cells(shiftDown, 5 + (i * 10) + 3).Value = "VOLTAGE"
    Range(Cells(shiftDown, 5 + (i * 10) + 3), Cells(count + shiftDown, 5 + (i * 10) + 3)).Interior.Color = RGB(110, 160, 180)
    'State of Charge
    Cells(shiftDown, 6 + (i * 10) + 3).Value = "SOC"
    'State of Health
    Cells(shiftDown, 7 + (i * 10) + 3).Value = "SOH"
    'Chip temperature
    Cells(shiftDown, 8 + (i * 10) + 3).Value = "TEMP_CHP"
    'Internal temperature
    Cells(shiftDown, 9 + (i * 10) + 3).Value = "TEMP_INT"
    'For Temperature of the terminal
    Cells(shiftDown, 10 + (i * 10) + 3).Value = "TEMP_EXT"
    Range(Cells(shiftDown, 10 + (i * 10) + 3), Cells(count + shiftDown, 10 + (i * 10) + 3)).Interior.Color = RGB(255, 190, 0)
Next i

'Add borders all around the data
Cells(shiftDown, 1).CurrentRegion.Borders.LineStyle = xlContinuous
'Autofit all the columns
Cells(shiftDown, 1).CurrentRegion.EntireColumn.AutoFit

'Plotting
'Activate the first sheet for data plotting
Worksheets("Data").Activate
'Add a new plot
Set battChart = Sheets("Plots").ChartObjects.Add(0, 0, 1200, 300)
'Plot the battery data
With battChart.Chart
    .SetSourceData Source:=Sheets("Data").Range(Cells(5, 8), Cells(count + shiftDown, 8))
    .SeriesCollection(1).Name = "Battery 1"
    .ChartWizard Title:="Voltage", HasLegend:=True, CategoryTitle:="Time (s)", ValueTitle:="Voltage (V)", Gallery:=xlXYScatterLinesNoMarkers
    For i = 2 To monitorNum
        .SeriesCollection.NewSeries
        .SeriesCollection(i).Values = Sheets("Data").Range(Cells(5, ((i - 1) * 10) + 8), Cells(count + shiftDown, ((i - 1) * 10) + 8))
        .SeriesCollection(i).Name = "Battery " & i
    Next i
End With

'Add a new plot
Set currChart = Sheets("Plots").ChartObjects.Add(0, 300, 1200, 300)
'Plot the current data
With currChart.Chart
    .SetSourceData Source:=Sheets("Data").Range(Cells(5, 7), Cells(count + shiftDown, 7))
    .SeriesCollection(1).Name = "Battery 1"
    .ChartWizard Title:="Current", HasLegend:=True, CategoryTitle:="Time (s)", ValueTitle:="Current (A)", Gallery:=xlXYScatterLinesNoMarkers
    For i = 2 To monitorNum
        .SeriesCollection.NewSeries
        .SeriesCollection(i).Values = Sheets("Data").Range(Cells(5, ((i - 1) * 10) + 7), Cells(count + shiftDown, ((i - 1) * 10) + 7))
        .SeriesCollection(i).Name = "Battery " & i
    Next i
End With

'Add a new plot
Set tempChart = Sheets("Plots").ChartObjects.Add(0, 600, 1200, 300)
'Plot the current data
With tempChart.Chart
    .SetSourceData Source:=Sheets("Data").Range(Cells(5, 13), Cells(count + shiftDown, 13))
    .SeriesCollection(1).Name = "Battery 1"
    .ChartWizard Title:="Temperature", HasLegend:=True, CategoryTitle:="Time (s)", ValueTitle:="Temperature (F)", Gallery:=xlXYScatterLinesNoMarkers
    For i = 2 To monitorNum
        .SeriesCollection.NewSeries
        .SeriesCollection(i).Values = Sheets("Data").Range(Cells(5, ((i - 1) * 10) + 13), Cells(count + shiftDown, ((i - 1) * 10) + 13))
        .SeriesCollection(i).Name = "Battery " & i
    Next i
End With

'Indicate that the macro has finished its job
Beep
MsgBox "Data separation is complete. There were " & errorCount & " errors found."

End Sub

Answer 1

您的所有Worksheets("x").Activate 都是完全不必要的，它们会显着减慢您的代码速度，并且当您忘记激活正确的工作表或您无聊的用户在执行过程中开始点击，因为它花费的时间太长时，它们会请求出现莫名其妙的错误。声明一些 Worksheet 变量并使用它们。

Dim DataSheet as Worksheet
ActiveSheet.Name = "Data"
Set DataSheet = ActiveSheet
Dim PlotSheet as Worksheet
Set PlotSheet as Worksheets.Add
Plotsheet.Name = "Plots"
Dim ErrorSheet as Worksheet
Set ErrorSheet = Worksheets.Add
ErrorSheet.Name = "Errors"

count = Datasheet.Cells(1, 1).CurrentRegion.Rows.count

        'GET RID OF THIS EVERYWHERE!!!  Worksheets("Errors").Activate
        'Save the row number and the monitor number where the error was founf
        With ErrorSheet
          .Cells(errorCount, 1).Value = "Voltage error in row"
          .Cells(errorCount, 2).Value = count - i + shiftDown
          .Cells(errorCount, 3).Value = "in column"
          .Cells(errorCount, 4).Value = (k * 10) + 8
          .Cells(errorCount, 5).Value = "in Monitor"
          .Cells(errorCount, 6).Value = k + 1
          .Cells(errorCount, 7).Value = "The recorded data was"

        'Note subtle change here:
          DataSheet.Cells(count - i + shiftDown, (k * 10) + 8).Copy .Cells(errorCount, 8)
        'Note: explicitly setting "datasheet" as the destination and using the "With" to save some typing on the ".Cells" call.
        'You could explicitly type the "ErrorSheet" to make it more clear
        'an even better version is:
        .cells(errorCount, 8) = DataSheet.Cells(count - i + shiftDown, (k * 10) + 8)
        End With

继续在任何地方这样做。未来你会欣赏现在的你...

每次您在执行 Sheet("x").Activate 时删除该行并明确添加对您之前声明的相应工作表变量的引用。

每次您有一个不合格的Sheets 或Cells 或Range 调用时，通过预先添加适当的工作表变量使其成为显式引用。将来您会欣赏这样一个事实，即您可以准确地看到您正在引用的工作表。当然，可能会涉及一些额外的输入，但额外输入显着减少了插入非常微妙且难以发现的错误的机会。

使用.Copy 对于单个单元格来说非常慢。如果您一次复制 large 块单元格，它确实会获得速度优势（在单个复制语句中大约 3-5k 个单元格，而不是通过设置单个单元格值进行循环） .

作为Uri Goren pointed out 设置Application.Calculation = False 肯定会提高你的速度。我建议不要设置Application.ScreenUpdating = False，直到之后您的代码100% 正常运行并且不会产生任何错误。一旦你到了那个地步，这是一件很棒的事情。

此时，您可能需要在代码中添加指示的行：

'Iterate through the points separating the Data
For i = 0 To count - 1
  'Add this line:
    Application.StatusBar = "Separating points #" & i

在每个大循环的顶部放置一条类似的消息。您可能会看到您的代码没有挂起，只是需要 很长 时间来处理。另外，您将获得用户可以观看的更新，这样他（s）就会知道它没有挂起并且仍在做某事。

在你的代码末尾：

Application.StatusBar = ""

清除消息，以便恢复正常的 Excel StatusBar 功能。

Answer 2

在子程序的开头添加这两行：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

以及子程序结束前的这两行

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True

它应该会显着加快您的代码速度