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

我对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

---

在子例程的开头添加以下两行：

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

这两行在子程序结束之前

Application.Calculation = xlCalculationAutomatic 
Application.ScreenUpdating = True

---

它会大大加快代码的速度

您所有的

工作表（“x”）。激活

完全是不必要的，它会大大降低代码的速度，并且在您忘记激活正确的工作表，或者您的无聊用户在执行过程中因为时间太长而开始四处点击时，会出现无法解释的错误。声明一些

工作表

变量并使用它们

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

继续在任何地方这样做。未来你会感激现在的你

每次执行

工作表（“x”）时。激活
删除该行，并显式添加对先前声明的相应工作表变量的引用

每次
调用不合格的
工作表
或
单元格
或
范围
时，通过在适当的工作表变量前面加上前缀，使其成为显式引用。将来，您会发现，您可以准确地看到所引用的工作表。当然，可能会涉及一些额外的类型，但是额外的类型会大大减少插入非常微妙和难以发现的bug的机会

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

设置
Application.Calculation=False
肯定会提高速度。我建议不要设置
Application.screenUpdate=False
，直到您的代码100%正常运行并且不会产生任何错误。一旦你达到了这一点，这是一件很棒的事情

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

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

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

在代码末尾，输入：

Application.StatusBar = ""

清除消息以便返回正常的Excel
状态栏功能。
除非关闭，否则不会崩溃。它停止响应，因为它正在运行代码，而当代码运行时，它不能做任何其他事情。等一下，看看是否结束。给它很长时间，它正在做很多事情。如果你想得到加速帮助，请将此贴在上面以获得加速帮助。你是对的。我花了大约10分钟的时间处理了600000行数据，它很高兴这能有所帮助。