几千行数据后，效率不佳的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, 我乐于接受任何build议，并乐于学习。 感谢您的提前帮助和帮助。
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
所有Worksheets("x").Activate是完全没有必要的，会显着减慢你的代码，当你忘记激活正确的工作表或者你的无聊用户在执行期间开始点击四周，因为时间太长而乞求莫名其妙的错误。 声明一些Worksheetvariables并使用这些variables。
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消除该行，并显式地添加一个引用到你之前声明的适当的工作表variables。
每当您有一个不合格的Sheets或Cells或Range调用时，通过预先考虑相应的工作表variables使其成为一个明确的引用。 未来，你会明白，你可以看到你正在参考什么工作表。 当然，可能还有一些额外的打字，但是额外打字大大减less了插入非常微妙和难以发现错误的机会。
对单个单元使用.Copy非常慢。 如果您一次性复制大块单元格（通过设置单个单元格值，在单个复制语句中的3-5k单元附近与循环中的某处相邻），它确实会获得速度优势。
正如Uri Goren指出的设置Application.Calculation = False肯定会提高你的速度。 我build议不要设置Application.ScreenUpdating = False直到你的代码是100％的function，并没有产生任何错误。 一旦你在这一点上，这是一件好事。
在你的代码中的这一点，你可能想要添加指定的行：
'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 StatusBarfunction。
在子程序的开头添加这两行：
Application.ScreenUpdating = False Application.Calculation = xlCalculationManual
子程序结束前的这2行
Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True
它应该显着加快你的代码