我是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
答案 0 :(得分：1)
在子程序的开头添加这两行：
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
在子程序结束前的这2行
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
它应该显着加快您的代码
答案 1 :(得分：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非常慢。如果你在一次复制中复制大型单元格块（单个复制语句中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
在每个大循环的顶部放置一条类似的消息。您可能会看到您的代码没有挂起，只需花费很长的时间来处理。此外，您将获得一个用户可以观看的更新，以便他知道它没有挂起并且仍在做某事。
在代码结束时：
Application.StatusBar = ""
要清除消息，以便返回正常的Excel StatusBar功能。