昨天我回家的时候，我的代码工作正常。我今天开始工作，现在每次运行代码时，Excel开始表现得很时髦。它不保存工作簿，返回msgbox＆＃34;文档未保存＆＃34;。当我打开电脑（应该已经睡觉）时，它完全从不正确的关机模式开始。我不确定这是否是导致问题的原因。我已经尝试将代码用于完全不同的工作簿，但仍然存在相同的问题。此外，在我运行代码后，如果我点击＆＃34;文件＆＃34;标签，没有显示任何内容。任何人都对这个问题有任何见解？感谢。
我很确定代码很好，但现在就是。
Sub TripLines()
Application.ScreenUpdating = False
Call AddGMTDateTimeStampsColumns
Call ComputeGMTDateTimeStamps
Call DeleteNonStampColumns
Call SplitLegStamp
Call CreateLegStamp
Call DeleteNonLegStampColumns
Call BuildLines
Call FindLastLeg
Call LineLegCount
Call TrimDownTripLines
Application.ScreenUpdating = True
End Sub
Sub TrimDownTripLines()
Dim Z As Integer
Z = Cells(1, 3).End(xlDown).Row
On Error Resume Next
'Trim down Lines
Sheets("DataImport").Range = Range(Cells(1, 1), (Cells(Z, 16384)))
Sheets("DataImport").Sort.SortFields.Clear
Sheets("DataImport").Sort.SortFields.Add Key:=Range( _
Cells(1, 1), (Cells(Z, 1))), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
Sheets("DataImport").Sort.SortFields.Add Key:=Range( _
Cells(1, 2), (Cells(Z, 2))), SortOn:=xlSortOnValues, Order:=xlDescending, _
DataOption:=xlSortNormal
With Sheets("DataImport").Sort
.SetRange Range(Cells(1, 1), (Cells(Z, 16384)))
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Sheets("DataImport").Activate
Call RemoveDuplicateLines
End Sub
Sub LineLegCount()
Dim Z As Long
Dim LC As Long
Dim i As Long
Dim Trip As Range
Z = Sheets("DataImport").Cells(1, 3).End(xlDown).Row
On Error Resume Next
For i = 2 To Z
Set Trip = Range(Cells(i, 3), (Cells(i, 3).End(xlToRight)))
LC = Trip.Count
Sheets("DataImport").Cells(i, 2) = LC
Next i
End Sub
Sub FindLastLeg()
Dim LL As String
Dim i As Long
Columns(1).Select
'Range("A460").Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Cells(1, 1) = "Last Leg Stamp"
Cells(1, 2) = "Line Leg Count"
Z = Cells(1, 3).End(xlDown).Row
For i = 2 To Z
LL = Cells(i, 3).End(xlToRight)
Sheets("DataImport").Cells(i, 1) = LL
Next i
End Sub
Sub FilterByFleet()
UF_FleetSelect.Show
End Sub
Sub BuildLines()
'strings together segments into trip
Dim i As Long
Dim Z As Long
Dim T As Long
Dim LegTable As Range
Dim y As String
Dim b As String
Dim MyTimer As Double
'ThisWorkbook.Save
DoEvents
Range(Cells(1, 3), (Cells(1048576, 16384))).Clear
Set LegTable = Range(Cells(2, 1), Cells(2, 2).End(xlDown))
Z = Cells(1, 1).End(xlDown).Row
For i = 2 To Z
MyTimer = Timer
Do
Loop While Timer - MyTimer < 0.03
Application.StatusBar = "Progress: " & i & " of " & Z & " " & Format(i / Z, "Percent")
On Error Resume Next
y = WorksheetFunction.VLookup(Cells(i, 2), LegTable, 2, False)
If y = "" Then
GoTo NextI
Else
Cells(i, 1).End(xlToRight).Offset(0, 1).Value2 = y
Do Until WorksheetFunction.VLookup(Cells(i, 2).End(xlToRight), LegTable, 1, False) = False
b = WorksheetFunction.VLookup(Cells(i, 2).End(xlToRight), LegTable, 2, False)
If b = "" Then
GoTo NextI
Else:
Cells(i, 1).End(xlToRight).Offset(0, 1) = b
End If
b = ""
Loop
NextI:
End If
b = ""
y = ""
Next i
Application.StatusBar = False
End Sub
Sub DeleteNonLegStampColumns()
Dim DelColumns As Range
With Sheets("DataImport")
Set DelColumns = Range(Columns(1), Columns(12))
End With
DelColumns.Delete
Range(Columns(1), Columns(2)).Select
Selection.EntireColumn.AutoFit
Cells(1, 1) = "Incoming Leg Stamp"
Cells(1, 2) = "Outgoing Leg Stamp"
End Sub
Sub CreateLegStamp()
Dim InBndLegStamp As String
Dim OutBndLegStamp As String
Dim i As Long
Dim Z As Long
On Error Resume Next
Z = Cells(2, 1).End(xlDown).Row
' Inbound Dept GMT Date/Time Stamp
For i = 2 To Z
InBndLegStamp = (Cells(i, 1) & " " & Cells(i, 2) & " " & Cells(i, 3) & _
" " & Cells(i, 4) & " " & Cells(i, 5) & " " & Cells(i, 6))
Cells(i, 13).Value = InBndLegStamp
OutBndLegStamp = (Cells(i, 7) & " " & Cells(i, 8) & " " & Cells(i, 9) & _
" " & Cells(i, 10) & " " & Cells(i, 11) & " " & Cells(i, 6))
Cells(i, 14).Value = OutBndLegStamp
Next i
End Sub
Sub SplitLegStamp()
Range(Cells(2, 14), Cells(2, 18)) = Split(Cells(2, 13), " ")
End Sub
Sub DeleteNonStampColumns()
Dim DelColumns As Range
With Sheets("DataImport")
Set DelColumns = Union(.Columns(1), .Columns(5), .Columns(7), .Columns(8), .Columns(11), .Columns(12), .Columns(16), .Columns(17), .Columns(18))
End With
DelColumns.Delete
End Sub
Sub AddGMTDateTimeStampsColumns()
'insert columns for time stamps
'Inbound Dept GMT Date/Time Stamp Column
Range(Cells(1, 6), Cells(1, 6)).EntireColumn.Insert
Cells(1, 6) = "Inbound Dept GMT Date/Time"
'Inbound Arrival GMT Date/Time Stamp Column
Range(Cells(1, 9), Cells(1, 9)).EntireColumn.Insert
Cells(1, 9) = "Inbound Arvl GMT Date/Time"
'Outbound Dept GMT Date/Time Stamp Column
Range(Cells(1, 19), Cells(1, 19)).EntireColumn.Insert
Cells(1, 19) = "Outbound Dept GMT Date/Time"
'Outbound Arvl GMT Date/Time Stamp Column
Range(Cells(1, 20), Cells(1, 20)).EntireColumn.Insert
Cells(1, 20) = "Outbound Arvl GMT Date/Time"
End Sub
Sub ComputeGMTDateTimeStamps()
Dim i As Long
Dim Z As Long
Dim IDDate As Date
'On Error Resume Next
Z = Cells(2, 1).End(xlDown).Row
' Inbound Dept GMT Date/Time Stamp
For i = 2 To Z
IDDate = CDate(Cells(i, 1) + Cells(i, 5))
Cells(i, 6).Value = IDDate
Next i
Set Column6 = Range(Cells(2, 6), Cells(2, 6).End(xlDown))
Column6.Select
Selection.NumberFormat = "m/d/yy hh:mm"
' Inbound Arival GMT Date/Time Stamp
For i = 2 To Z
IDDate = CDate(Cells(i, 6) + Cells(i, 8))
Cells(i, 9).Value = IDDate
Next i
Set Column9 = Range(Cells(2, 9), Cells(2, 9).End(xlDown))
Column9.Select
Selection.NumberFormat = "m/d/yy hh:mm"
' Outbound Dept GMT Date/Time Stamp
For i = 2 To Z
IDDate = CDate(Cells(i, 9) + Cells(i, 12))
Cells(i, 19).Value = IDDate
Next i
Set Column19 = Range(Cells(2, 19), Cells(2, 19).End(xlDown))
Column19.Select
Selection.NumberFormat = "m/d/yy hh:mm"
' Outbound Arvl GMT Date/Time Stamp
For i = 2 To Z
IDDate = CDate(Cells(i, 19) + Cells(i, 18))
Cells(i, 20).Value = IDDate
Next i
Set Column20 = Range(Cells(2, 20), Cells(2, 20).End(xlDown))
Column20.Select
Selection.NumberFormat = "m/d/yy hh:mm"
End Sub
模块：
Sub RemoveDuplicateLines()
Dim rng As Range
Dim x As Double
Dim C As Double
Dim Z As Integer
Z = ActiveSheet.Cells(1, 3).End(xlDown).Row
Set rng = ActiveSheet.Range(Cells(2, 2), Cells(2, 2).End(xlDown))
x = Application.WorksheetFunction.Max(rng)
C = x + 3
ActiveSheet.Range(Cells(2, 1), (Cells(Z, C))).RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
答案 0 :(得分：0)
请按照以下步骤操作。
有时模块可能会损坏，尤其是在系统关闭或重启不正确的情况下。如果这不起作用，您可能需要重新安装办公室。
您的代码本身没有任何问题。
答案 1 :(得分：0)
更新!!因此，当我创建新工作簿并粘贴记事本中的代码时，我仍然遇到了同样的问题。我终于能够解决问题并发现如果我来回application.screenupdating状态，就会导致问题。一旦我将其调整为仅仅通过false/true语句一次，就完全摆脱了我的问题。谢谢你的帮助，伙计们。