<think>我们遇到了“要求对象”的错误,特别是在判断`If Sheet5 Is Nothing Then`时。这个错误通常是因为我们试图使用一个未初始化的对象变量(即Sheet5还没有被赋值)。在VBA中,当我们声明一个对象变量但没有使用Set语句将其分配给实际对象时,该变量为Nothing。但是,如果代码中从未声明或创建Sheet5,那么直接检查`Sheet5 Is Nothing`会导致错误,因为VBA可能认为Sheet5是一个未声明的变量。
解决方案:
1. 确保在使用Sheet5之前,它已经被正确初始化(即工作表存在)。
2. 避免直接使用工作表名称作为变量(除非我们使用ThisWorkbook.Worksheets("ErrorLog")来引用)。
3. 使用错误处理来避免尝试访问不存在的对象。
在之前的代码中,我们在多个地方使用了Sheet5,但可能没有确保该工作表一定存在。因此,我们需要修改错误日志记录部分,确保在写入日志前工作表已经存在。
具体修改:
在LogError子过程中,我们首先检查Sheet5是否被设置(即工作表是否存在)。如果不存在,则创建它。但是,我们之前使用`If Sheet5 Is Nothing Then`来检查,这实际上是不安全的,因为Sheet5可能未被定义。
更安全的方法:
我们可以使用一个函数来获取或创建ErrorLog工作表,并返回该工作表对象。这样,在需要写入日志时,我们调用这个函数来确保工作表存在。
但是,由于我们的代码中直接使用Sheet5,而Sheet5可能是一个全局变量或未定义,因此我们需要改变策略:在LogError过程中,使用On Error Resume Next来尝试引用工作表,如果引用失败(即工作表不存在),则创建它。
修改后的LogError过程:
然而,考虑到项目结构,我们可能没有将Sheet5声明为全局对象。在VBA中,我们可以通过工作表名称来引用工作表,但更安全的方式是使用工作表变量,并通过代码设置它。
由于我们使用的是代码名称(例如Sheet1、Sheet2等),这些是VBA工程中工作表的代码名称,所以它们总是可用的,但前提是这些工作表没有被删除。如果“ErrorLog”工作表是后来添加的,那么它可能没有代码名称(如Sheet5),或者代码名称可能不同。
因此,我们建议使用工作表的名称(如"ErrorLog")来引用工作表,而不是代码名称(如Sheet5)。这样更可靠,因为代码名称在VBA工程中可能改变,而工作表名称是用户可见的。
修改步骤:
1. 在LogError过程中,我们使用ThisWorkbook.Worksheets("ErrorLog")来引用工作表。
2. 如果工作表不存在,则创建它并设置表头。
3. 使用一个局部变量来引用工作表,避免直接使用代码名称(如Sheet5)。
同样,在GetTraveltime函数中,我们也要修改对ErrorLog工作表的引用方式。
由于这个错误发生在条件判断`If Sheet5 Is Nothing Then`,我们可以推断,Sheet5这个对象变量并没有被正确初始化(可能是因为ErrorLog工作表不存在,或者我们没有使用Set语句将其赋值)。因此,我们修改为使用工作表名称来引用。
修改后的LogError过程:
但是,由于我们可能需要在多个地方引用ErrorLog工作表,我们可以编写一个辅助函数来获取ErrorLog工作表,这样避免重复代码。
不过,为了快速解决问题,我们在LogError过程中直接处理:
修改后的LogError:
```vba
Sub LogError(ByVal errorType As String, ByVal vehicleID As String, ByVal stopOrder As Integer, ByVal time1 As Variant, ByVal time2 As Variant)
On Error Resume Next ' 防止工作表不存在时出错
Dim wsLog As Worksheet
Set wsLog = ThisWorkbook.Worksheets("ErrorLog")
If wsLog Is Nothing Then
' 创建ErrorLog工作表
Set wsLog = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wsLog.Name = "ErrorLog"
' 设置表头
wsLog.Cells(1, 1) = "时间戳"
wsLog.Cells(1, 2) = "错误类型"
wsLog.Cells(1, 3) = "车辆编号"
wsLog.Cells(1, 4) = "站点次序"
wsLog.Cells(1, 5) = "时间1"
wsLog.Cells(1, 6) = "时间2"
End If
On Error GoTo 0 ' 恢复错误处理
Dim logRow As Long
logRow = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row + 1
wsLog.Cells(logRow, 1) = Now()
wsLog.Cells(logRow, 2) = errorType
wsLog.Cells(logRow, 3) = vehicleID
wsLog.Cells(logRow, 4) = stopOrder
If Not IsEmpty(time1) Then
wsLog.Cells(logRow, 5) = Format(time1, "yyyy-mm-dd hh:mm:ss")
Else
wsLog.Cells(logRow, 5) = ""
End If
If Not IsEmpty(time2) Then
wsLog.Cells(logRow, 6) = Format(time2, "yyyy-mm-dd hh:mm:ss")
Else
wsLog.Cells(logRow, 6) = ""
End If
End Sub
```
同时,在GetTraveltime函数中,我们也要修改对ErrorLog的引用,不再使用Sheet5,而是使用上面的方式(通过名称引用)。但是,由于GetTraveltime函数中我们只调用了LogError,而LogError已经处理了工作表的创建,因此我们可以删除GetTraveltime中关于创建ErrorLog的代码。
另外,在GetTraveltime函数中,我们之前有:
```vba
' 确保错误日志表存在
If Sheet5 Is Nothing Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "ErrorLog"
Sheet5.Cells(1, 1) = "时间戳"
...
End If
```
这部分可以完全删除,因为LogError过程会确保工作表存在。
所以,修改后的GetTraveltime函数中,删除创建ErrorLog的代码,只保留表头初始化(表头初始化在LogError中已经做了,所以这里不需要)。
同样,在GetTrip函数中,我们调用LogError时,也是使用新的LogError过程,所以也不需要提前创建ErrorLog。
因此,我们重新整理:
1. 删除GetTraveltime函数中创建ErrorLog的代码块。
2. 确保LogError过程使用上述修改后的版本。
另外,在GetTrip函数中,我们也有调用LogError,所以整个项目中我们都使用新的LogError。
注意:由于我们修改了LogError,现在它使用工作表名称“ErrorLog”来引用,这样更可靠。
同时,由于我们不再使用Sheet5这个代码名称,所以我们可以从代码中移除所有对Sheet5的直接引用(即用wsLog代替)。
但是,在GetTraveltime函数中,我们还有一些地方调用了LogError,这些调用不需要改变,因为参数传递方式不变。
最后,我们还需要注意,在GetTraveltime函数中,我们之前有使用Sheet5来记录错误,现在改为通过LogError过程,所以应该没问题。
修改后的代码(仅显示修改部分):
由于我们修改了LogError,因此需要将整个LogError过程替换为上述代码。
同时,在GetTraveltime函数中,删除以下代码块:
```vba
' 确保错误日志表存在
If Sheet5 Is Nothing Then
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "ErrorLog"
Sheet5.Cells(1, 1) = "时间戳"
Sheet5.Cells(1, 2) = "错误类型"
Sheet5.Cells(1, 3) = "车辆编号"
Sheet5.Cells(1, 4) = "站点次序"
Sheet5.Cells(1, 5) = "时间1"
Sheet5.Cells(1, 6) = "时间2"
End If
```
这样,当LogError被调用时,它会自动创建ErrorLog工作表(如果需要)并写入日志。
我们还需要修改SaveIncompleteEvents和ProcessStationEvent中的LogError调用,确保它们也使用新的LogError过程。不过,这些调用本身没有变化,因为参数传递方式一致。
最后,由于我们不再依赖Sheet5这个全局变量,所以不会出现“要求对象”的错误。
但是,我们还需要考虑另一种情况:如果ErrorLog工作表被用户重命名或删除,我们的代码也能处理。上面的LogError过程已经处理了这种情况,因为每次调用LogError时,都会尝试通过名称获取工作表,如果不存在则重新创建。
因此,我们提供完整的修改后代码(只包含修改的部分,其他部分不变):
由于篇幅,我只写出修改后的LogError和GetTraveltime函数(删除创建日志表头的部分),其他函数和过程不变。
注意:在GetTraveltime函数中,我们删除了创建ErrorLog的代码块,所以函数开头变成:
```vba
Function GetTraveltime()
Dim lastRow As Long, i As Long, k As Long
Dim inTime As Variant, outTime As Variant, nextInTime As Variant
Dim tripRow As Long
Dim prevOutTime As Variant
' 删除之前创建ErrorLog的代码块,因为LogError过程会处理
' 初始化表3/表4表头
Sheet3.Cells(1, 1) = "班次"
Sheet3.Cells(1, 2) = "车辆编号"
Sheet4.Cells(1, 1) = "班次"
Sheet4.Cells(1, 2) = "车辆编号"
... ' 其余不变
```
同时,在GetTrip函数中,我们也不需要初始化ErrorLog,所以保持原样。
这样修改后,当代码运行到LogError时,会动态获取或创建ErrorLog工作表,从而避免“要求对象”的错误。
如果问题仍然存在,请检查是否还有其他地方直接使用了Sheet5。如果有,请将其改为通过工作表名称引用。
由于我们在整个项目中已经删除了对Sheet5的直接引用,所以不会再出现Sheet5未定义的情况。
最后,我们还需要注意:在VBA中,使用On Error Resume Next需要谨慎,我们在LogError中使用了它来避免工作表不存在时的错误,但在获取工作表后立即恢复了错误处理(On Error GoTo 0)。
如果按照上述修改后,应该能解决“要求对象”的错误。
完整代码修改示例(LogError过程):
由于用户要求提供完整代码,但之前代码较长,这里只提供修改的关键部分。用户需要将LogError过程替换为以下代码:
```vba
Sub LogError(ByVal errorType As String, ByVal vehicleID As String, ByVal stopOrder As Integer, ByVal time1 As Variant, ByVal time2 As Variant)
On Error Resume Next ' 防止在获取工作表时出错(如果工作表不存在)
Dim wsLog As Worksheet
Set wsLog = ThisWorkbook.Worksheets("ErrorLog")
If wsLog Is Nothing Then
' 创建ErrorLog工作表
Set wsLog = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
wsLog.Name = "ErrorLog"
' 设置表头
wsLog.Cells(1, 1) = "时间戳"
wsLog.Cells(1, 2) = "错误类型"
wsLog.Cells(1, 3) = "车辆编号"
wsLog.Cells(1, 4) = "站点次序"
wsLog.Cells(1, 5) = "时间1"
wsLog.Cells(1, 6) = "时间2"
End If
On Error GoTo 0 ' 恢复正常的错误处理
' 如果还是无法获取工作表,则退出
If wsLog Is Nothing Then
Exit Sub
End If
Dim logRow As Long
logRow = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row + 1
If logRow < 2 Then logRow = 2 ' 如果工作表为空,则从第2行开始
wsLog.Cells(logRow, 1) = Now()
wsLog.Cells(logRow, 2) = errorType
wsLog.Cells(logRow, 3) = vehicleID
wsLog.Cells(logRow, 4) = stopOrder
If Not IsEmpty(time1) Then
wsLog.Cells(logRow, 5) = Format(time1, "yyyy-mm-dd hh:mm:ss")
Else
wsLog.Cells(logRow, 5) = ""
End If
If Not IsEmpty(time2) Then
wsLog.Cells(logRow, 6) = Format(time2, "yyyy-mm-dd hh:mm:ss")
Else
wsLog.Cells(logRow, 6) = ""
End If
End Sub
```
同时,在GetTraveltime函数中,删除创建ErrorLog工作表的代码块(即删除从`' 创建错误日志表`到`Sheet5.Cells(1, 6) = "时间2"`的代码)。
在GetTrip函数中,我们不需要修改,因为它只调用LogError。
这样修改后,代码应该不再出现“要求对象”的错误。
如果用户仍然遇到问题,可能需要检查其他部分是否还有直接使用Sheet5的情况,如果有,请删除或修改。
最后,我们提供修改后的完整代码(由于代码较长,请用户自行替换LogError过程,并删除GetTraveltime中创建ErrorLog的代码块)。
注意:在运行整个代码之前,最好先清除ErrorLog工作表,或者确保它存在且格式正确。
如果用户需要,我们可以提供整个修改后的VBA工程,但这里只提供关键修改。
由于问题只出现在Sheet5的引用上,所以其他部分保持不变。
修改后,重新运行代码,观察是否还有“要求对象”的错误。
如果问题解决,我们就可以继续处理其他问题。
如果用户还有其他错误,请提供详细信息。
注意:由于我们使用了工作表名称“ErrorLog”,请确保没有多个同名工作表,否则可能导致错误。
另外,我们在创建新工作表时,使用`After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)`将新工作表放在最后。
现在,我们输出修改后的完整代码(仅包含修改部分,其他部分参考之前提供的代码)。</think>针对"要求对象"的错误和`If Sheet5 Is Nothing Then`调试问题,我将提供完整的解决方案。这个错误通常是由于对象引用无效或工作表未正确初始化造成的。以下是修复后的代码:
```vba
' 修复对象引用问题的完整解决方案
Option Explicit ' 强制变量声明
' 全局声明工作表对象
Dim wsSheet1 As Worksheet, wsSheet2 As Worksheet
Dim wsSheet3 As Worksheet, wsSheet4 As Worksheet
Dim wsErrorLog As Worksheet
' 初始化工作表对象
Sub InitializeWorksheets()
On Error Resume Next
Set wsSheet1 = ThisWorkbook.Sheets("原始数据") ' 根据实际表名修改
Set wsSheet2 = ThisWorkbook.Sheets("班次数据") ' 根据实际表名修改
Set wsSheet3 = ThisWorkbook.Sheets("行程时间") ' 根据实际表名修改
Set wsSheet4 = ThisWorkbook.Sheets("停靠时间") ' 根据实际表名修改
' 确保错误日志表存在
Set wsErrorLog = Nothing
On Error Resume Next
Set wsErrorLog = ThisWorkbook.Sheets("ErrorLog")
On Error GoTo 0
If wsErrorLog Is Nothing Then
Set wsErrorLog = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsErrorLog.Name = "ErrorLog"
' 初始化错误日志表头
wsErrorLog.Cells(1, 1) = "时间戳"
wsErrorLog.Cells(1, 2) = "错误类型"
wsErrorLog.Cells(1, 3) = "车辆编号"
wsErrorLog.Cells(1, 4) = "站点次序"
wsErrorLog.Cells(1, 5) = "时间1"
wsErrorLog.Cells(1, 6) = "时间2"
wsErrorLog.Cells(1, 7) = "错误描述"
End If
End Sub
' 修复版班次提取模块 (GetTrip)
Function GetTrip()
' 初始化工作表
Call InitializeWorksheets
Dim lastRow As Long, i As Long, k As Long
Dim vehicleID As String, currentVehicle As String
Dim tripCount As Long, currentTripRow As Long
Dim eventTime As Date, stopOrder As Integer
Dim tripStartRow As Long
Dim stationEvents As Object
Dim colPos As Long
' 获取总行数
lastRow = wsSheet1.Cells(wsSheet1.Rows.Count, 1).End(xlUp).Row
' 初始化变量
tripCount = 0
currentVehicle = ""
tripStartRow = 2
Set stationEvents = CreateObject("Scripting.Dictionary")
' 按车辆、站点和时间排序原始数据
With wsSheet1.Sort
.SortFields.Clear
.SortFields.Add Key:=wsSheet1.Range("A2:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending ' 车辆编号
.SortFields.Add Key:=wsSheet1.Range("C2:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending ' 站点次序
.SortFields.Add Key:=wsSheet1.Range("B2:B" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending ' GPS时间
.SetRange wsSheet1.Range("A1:C" & lastRow)
.Header = xlYes
.Apply
End With
' 初始化表2表头
wsSheet2.Cells(1, 1) = "班次"
wsSheet2.Cells(1, 2) = "车辆编号"
For k = 1 To 32
wsSheet2.Cells(1, 2 * k + 1) = k & "in"
wsSheet2.Cells(1, 2 * k + 2) = k & "out"
Next k
' 遍历原始数据构建班次
currentVehicle = ""
For i = 2 To lastRow
vehicleID = wsSheet1.Cells(i, 1).Value
eventTime = wsSheet1.Cells(i, 2).Value
stopOrder = wsSheet1.Cells(i, 3).Value
' 新车辆检测
If vehicleID <> currentVehicle Then
' 保存上一辆车的未完成记录
If currentVehicle <> "" Then
Call SaveIncompleteEvents(stationEvents, currentTripRow)
End If
currentVehicle = vehicleID
tripCount = tripCount + 1
currentTripRow = tripStartRow
' 写入班次基础信息
wsSheet2.Cells(currentTripRow, 1) = tripCount
wsSheet2.Cells(currentTripRow, 2) = vehicleID
' 初始化该班次所有站点为空
For k = 1 To 32
colPos = 2 + (k - 1) * 2
wsSheet2.Cells(currentTripRow, colPos + 1) = ""
wsSheet2.Cells(currentTripRow, colPos + 2) = ""
Next k
tripStartRow = tripStartRow + 1
' 重置站点状态跟踪
Set stationEvents = CreateObject("Scripting.Dictionary")
End If
' 处理当前站点的记录
Call ProcessStationEvent(stationEvents, vehicleID, stopOrder, eventTime, currentTripRow)
Next i
' 保存最后一辆车的未完成记录
If currentVehicle <> "" Then
Call SaveIncompleteEvents(stationEvents, currentTripRow)
End If
End Function
' 处理站点事件
Sub ProcessStationEvent(ByRef stationEvents As Object, ByVal vehicleID As String, ByVal stopOrder As Integer, ByVal eventTime As Date, ByVal currentTripRow As Long)
Dim stationKey As String
stationKey = vehicleID & "|" & stopOrder
If Not stationEvents.Exists(stationKey) Then
' 首次遇到该站点
stationEvents(stationKey) = Array(eventTime, "incomplete", stopOrder)
Else
' 已存在该站点的记录
Dim prevEvent As Variant
prevEvent = stationEvents(stationKey)
' 确定事件类型(进站/出站)
If prevEvent(1) = "incomplete" Then
' 已有进站记录,当前应为出站
If eventTime >= prevEvent(0) Then ' 使用>=允许相同时间
' 写入出站时间
stationEvents(stationKey) = Array(prevEvent(0), eventTime, stopOrder)
' 写入表2
Dim colPos As Long
colPos = 2 + (stopOrder - 1) * 2
wsSheet2.Cells(currentTripRow, colPos + 1) = prevEvent(0) ' inTime
wsSheet2.Cells(currentTripRow, colPos + 2) = eventTime ' outTime
Else
' 时间顺序错误,保留最近的时间
stationEvents(stationKey) = Array(eventTime, "incomplete", stopOrder)
' 记录错误日志
Call LogError("时间顺序错误", vehicleID, stopOrder, prevEvent(0), eventTime, "进站时间晚于出站时间")
End If
End If
End If
End Sub
' 保存未完成的事件
Sub SaveIncompleteEvents(ByRef stationEvents As Object, ByVal currentTripRow As Long)
Dim key As Variant
For Each key In stationEvents.Keys
Dim evt As Variant
evt = stationEvents(key)
If evt(1) = "incomplete" Then
' 提取车辆和站点
Dim parts() As String
parts = Split(key, "|")
Dim vID As String
vID = parts(0)
Dim sOrder As Integer
sOrder = evt(2)
' 写入进站时间
Dim colPos As Long
colPos = 2 + (sOrder - 1) * 2
wsSheet2.Cells(currentTripRow, colPos + 1) = evt(0) ' inTime
' 出站时间留空
' 记录警告日志
Call LogError("缺少出站记录", vID, sOrder, evt(0), "", "只有进站时间,缺少出站时间")
End If
Next key
End Sub
' 增强的错误日志记录
Sub LogError(ByVal errorType As String, ByVal vehicleID As String, ByVal stopOrder As Integer, ByVal time1 As Variant, ByVal time2 As Variant, Optional ByVal errorDesc As String = "")
On Error Resume Next ' 防止日志记录失败导致整个程序崩溃
' 确保错误日志表已初始化
If wsErrorLog Is Nothing Then
Call InitializeWorksheets
End If
Dim logRow As Long
logRow = wsErrorLog.Cells(wsErrorLog.Rows.Count, 1).End(xlUp).Row + 1
If logRow < 2 Then logRow = 2 ' 如果工作表为空
wsErrorLog.Cells(logRow, 1) = Now()
wsErrorLog.Cells(logRow, 2) = errorType
wsErrorLog.Cells(logRow, 3) = vehicleID
wsErrorLog.Cells(logRow, 4) = stopOrder
wsErrorLog.Cells(logRow, 5) = IIf(IsEmpty(time1), "", Format(time1, "yyyy-mm-dd hh:mm:ss"))
wsErrorLog.Cells(logRow, 6) = IIf(IsEmpty(time2), "", Format(time2, "yyyy-mm-dd hh:mm:ss"))
wsErrorLog.Cells(logRow, 7) = errorDesc
End Sub
' 修复版行程时间计算模块 (GetTraveltime)
Function GetTraveltime()
' 初始化工作表
Call InitializeWorksheets
Dim lastRow As Long, i As Long, k As Long
Dim inTime As Variant, outTime As Variant, nextInTime As Variant
Dim tripRow As Long
Dim prevOutTime As Variant
' 初始化表3/表4表头
wsSheet3.Cells(1, 1) = "班次"
wsSheet3.Cells(1, 2) = "车辆编号"
wsSheet4.Cells(1, 1) = "班次"
wsSheet4.Cells(1, 2) = "车辆编号"
For k = 1 To 32
wsSheet3.Cells(1, k + 2) = "Link" & k
wsSheet4.Cells(1, k + 2) = "Stop" & k
Next k
lastRow = wsSheet2.Cells(wsSheet2.Rows.Count, 1).End(xlUp).Row
tripRow = 2
For i = 2 To lastRow
wsSheet3.Cells(tripRow, 1) = wsSheet2.Cells(i, 1)
wsSheet3.Cells(tripRow, 2) = wsSheet2.Cells(i, 2)
wsSheet4.Cells(tripRow, 1) = wsSheet2.Cells(i, 1)
wsSheet4.Cells(tripRow, 2) = wsSheet2.Cells(i, 2)
prevOutTime = Empty ' 重置前一站点出站时间
For k = 1 To 32
' 获取进站和出站时间
inTime = wsSheet2.Cells(i, 2 + (k - 1) * 2 + 1).Value
outTime = wsSheet2.Cells(i, 2 + (k - 1) * 2 + 2).Value
' ===== 站点停靠时间计算 (表4) =====
If Not IsEmpty(inTime) And Not IsEmpty(outTime) Then
If outTime >= inTime Then
wsSheet4.Cells(tripRow, 2 + k) = (outTime - inTime) * 24 * 60
Else
wsSheet4.Cells(tripRow, 2 + k) = "时间错误"
Call LogError("停靠时间错误", wsSheet2.Cells(i, 2), k, inTime, outTime, "出站时间早于进站时间")
End If
Else
If Not IsEmpty(inTime) Then
' 只有进站时间,没有出站时间
wsSheet4.Cells(tripRow, 2 + k) = "数据缺失(出站)"
Call LogError("缺少出站时间", wsSheet2.Cells(i, 2), k, inTime, "", "站点" & k & "缺少出站时间")
ElseIf Not IsEmpty(outTime) Then
' 只有出站时间,没有进站时间
wsSheet4.Cells(tripRow, 2 + k) = "数据缺失(进站)"
Call LogError("缺少进站时间", wsSheet2.Cells(i, 2), k, "", outTime, "站点" & k & "缺少进站时间")
Else
' 完全缺失
wsSheet4.Cells(tripRow, 2 + k) = "数据缺失"
End If
End If
' ===== 站间行程时间计算 (表3) =====
If k < 32 Then
nextInTime = wsSheet2.Cells(i, 2 + k * 2 + 1).Value ' 下一站的进站时间
' 修复Link1问题:使用前一站点出站时间或当前站点进站时间
Dim useTime As Variant
If k = 1 Then
' Link1特殊处理:使用当前站点出站时间
useTime = outTime
Else
' 其他Link:优先使用前一站点出站时间
useTime = prevOutTime
If IsEmpty(useTime) Then useTime = inTime
End If
If Not IsEmpty(useTime) And Not IsEmpty(nextInTime) Then
If nextInTime >= useTime Then
wsSheet3.Cells(tripRow, 2 + k) = (nextInTime - useTime) * 24 * 60
Else
wsSheet3.Cells(tripRow, 2 + k) = "时间错误"
Call LogError("行程时间错误", wsSheet2.Cells(i, 2), k, useTime, nextInTime, "到达时间早于出发时间")
End If
Else
If IsEmpty(useTime) And IsEmpty(nextInTime) Then
wsSheet3.Cells(tripRow, 2 + k) = "数据缺失"
ElseIf IsEmpty(useTime) Then
wsSheet3.Cells(tripRow, 2 + k) = "数据缺失(出发)"
Call LogError("缺少出发时间", wsSheet2.Cells(i, 2), k, "", nextInTime, "站点" & k & "缺少出发时间")
Else
wsSheet3.Cells(tripRow, 2 + k) = "数据缺失(到达)"
Call LogError("缺少到达时间", wsSheet2.Cells(i, 2), k, useTime, "", "站点" & k & "缺少到达时间")
End If
End If
End If
' 保存当前站点出站时间,供下一Link使用
prevOutTime = outTime
Next k
tripRow = tripRow + 1
Next i
End Function
' 主执行过程
Sub RunAll()
' 清除旧数据
Call ClearPreviousData
' 执行处理流程
Call GetTrip
Call GetTraveltime
MsgBox "数据处理完成!请检查ErrorLog工作表查看错误详情", vbInformation
End Sub
' 清除旧数据
Sub ClearPreviousData()
On Error Resume Next
wsSheet2.Range("A2:BZ10000").ClearContents
wsSheet3.Range("A2:BZ10000").ClearContents
wsSheet4.Range("A2:BZ10000").ClearContents
wsErrorLog.Range("A2:Z10000").ClearContents
End Sub
```
### 关键修复说明:
#### 1. 解决"要求对象"错误
- **问题根源**:工作表对象未正确初始化或已被删除
- **解决方案**:
```mermaid
graph TD
A[对象引用错误] --> B{原因分析}
B --> C[工作表不存在]
B --> D[工作表名称错误]
B --> E[对象未初始化]
C --> F[自动创建工作表]
D --> G[使用代码名称替代]
E --> H[添加初始化过程]
```
- 具体修复:
- 添加`InitializeWorksheets`过程确保所有工作表正确初始化
- 使用全局变量`wsSheet1`, `wsSheet2`等替代直接使用`Sheet1`, `Sheet2`
- 添加错误处理`On Error Resume Next`避免引用不存在的对象
- 自动创建缺失的ErrorLog工作表
#### 2. 工作表初始化机制
```vba
Sub InitializeWorksheets()
' 设置工作表对象
Set wsSheet1 = ThisWorkbook.Sheets('原始数据')
' ... 其他工作表设置
' 确保错误日志表存在
If wsErrorLog Is Nothing Then
Set wsErrorLog = ThisWorkbook.Sheets.Add(...)
wsErrorLog.Name = 'ErrorLog'
' 初始化表头
End If
End Sub
```
#### 3. 增强的错误日志系统
- 添加错误描述字段(第7列)
- 自动初始化错误日志表
- 防止日志记录失败导致整个程序崩溃
- 更详细的错误分类和描述
#### 4. 主执行流程优化
```vba
Sub RunAll()
Call ClearPreviousData ' 清除旧数据
Call GetTrip ' 提取班次数据
Call GetTraveltime ' 计算行程时间
MsgBox '处理完成' ' 用户反馈
End Sub
```
### 调试建议:
1. **调试工作表引用问题**:
```vba
Sub DebugWorksheetReferences()
Debug.Print "Sheet1: " & wsSheet1.Name
Debug.Print "Sheet2: " & wsSheet2.Name
Debug.Print "Sheet3: " & wsSheet3.Name
Debug.Print "Sheet4: " & wsSheet4.Name
Debug.Print "ErrorLog: " & wsErrorLog.Name
End Sub
```
2. **错误处理最佳实践**:
```vba
On Error GoTo ErrorHandler
' 主要代码
Exit Sub
ErrorHandler:
LogError "运行时错误", "", 0, "", "", "错误 " & Err.Number & ": " & Err.Description
Resume Next
```
3. **工作表存在性检查**:
```vba
Function WorksheetExists(sheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (ThisWorkbook.Sheets(sheetName).Name <> "")
On Error GoTo 0
End Function
```
### 使用说明:
1. **准备工作**:
- 确保工作簿中有名为"原始数据"、"班次数据"、"行程时间"、"停靠时间"的工作表
- 如果没有,代码会自动创建ErrorLog工作表
2. **执行顺序**:
- 运行`RunAll`宏处理所有数据
- 检查"ErrorLog"工作表中的错误详情
3. **常见问题解决**:
- **"要求对象"错误**:检查工作表名称是否匹配
- **类型不匹配**:确保原始数据格式正确
- **数据缺失**:检查原始数据完整性
4. **自定义配置**:
- 修改`InitializeWorksheets`中的工作表名称匹配实际表名
- 调整`For k = 1 To 32`中的站点数量