У меня есть код, который строит таблицу на основе данных в другом листе. На этом листе есть три столбца - Время, URN и Местоположение. Время отображается как ЧЧ: ММ: СС, URN - это четырехзначное число, а Location - это почтовый индекс, отображаемый в обычном формате.
Я обычно использовал этот код с датой вместо времени, но я пытался использовать его со временем. После внесения даты в переменную я внес небольшую корректировку, добавив часть значения времени.
Теперь я получаю
Ошибка времени выполнения '91': переменная объекта или переменная блока не установлена,
с выделением следующего:
.Cells(FndDt.Row, FndNum.Column) = "P"
Я попытался удалить этот кусок кода и добавить On Error Resume Next
, но затем я получаю сообщение об ошибке в строках выше или ниже его.
Option Explicit
Sub chrisellis250()
Dim Dt, Urn, i As Long, x As Long, lr As Long, lc As Long: x = 2
Dim colwidth As Long
Dim FndDt As Range, FndNum As Range, Dat As Date, Num As String, Loc As String
Dat = TimeValue("00:00:00")
Application.ScreenUpdating = False
With Sheet2
lr = .Cells(.Rows.Count, 2).End(xlUp).Row
.Range(.Cells(2, 1), .Cells(.Rows.Count, 1)).AdvancedFilter xlFilterCopy, , .Range("E1"), True
With .Range("E1").CurrentRegion: Dt = .Value: End With
Sheet1.Range("A3").Resize(UBound(Dt) - 1) = .Range("E2:E" & UBound(Dt)).Value: .Columns(5).Clear
Sheet1.Range("A3").Resize(UBound(Dt) - 1).Interior.ColorIndex = 15
.Range(.Cells(2, 2), .Cells(.Rows.Count, 2)).AdvancedFilter xlFilterCopy, , .Range("E1"), True
With .Range("E1").CurrentRegion: Urn = .Value: End With
For i = 1 To 2
Sheet1.Cells(2, x).Resize(, UBound(Urn) - 1) = Application.WorksheetFunction.Transpose(.Range("E2:E" & UBound(Urn)).Value)
If i = 1 Then colwidth = 8.3 Else colwidth = 55
Sheet1.Cells(2, x).Resize(, UBound(Urn) - 1).ColumnWidth = colwidth
If x = 2 Then Sheet1.Cells(1, x) = "URN" Else Sheet1.Cells(1, x) = "XXXXX"
Sheet1.Cells(1, x).Resize(, UBound(Urn) - 1).MergeCells = True
Sheet1.Cells(1, x).Resize(, UBound(Urn) - 1).Interior.ColorIndex = 15
x = x + UBound(Urn) - 1
Next i
.Columns(5).Clear
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If .Range("B" & i) <> "" Then
Dat = .Range("A" & i): Num = .Range("B" & i): Loc = .Range("C" & i)
With Sheet1
.Range("B3").Resize(lr, UBound(Urn) - 1).Font.Name = "Wingdings 2"
lc = .Cells(2, .Columns.Count).End(xlToLeft).Column
Set FndDt = .Range("A:A").Find(Dat, LookIn:=xlValues, lookat:=xlWhole)
Set FndNum = .Range(.Cells(2, 1), .Cells(2, lc)).Find(Num, LookIn:=xlValues, lookat:=xlWhole)
.Cells(FndDt.Row, FndNum.Column) = "P": .Cells(FndDt.Row, FndNum.Column).Font.Color = vbGreen
On Error Resume Next
If Not .Cells(FndDt.Row, FndNum.Column + UBound(Urn) - 1) Like "*" & Loc & "*" Then
.Cells(FndDt.Row, FndNum.Column + UBound(Urn) - 1) = IIf(.Cells(FndDt.Row, FndNum.Column + UBound(Urn) - 1) = "", Loc, .Cells(FndDt.Row, FndNum.Column + UBound(Urn) - 1) & "," & Loc)
End If
End With
End If
Next i
With Sheet1
With .Range("B3").Resize(UBound(Dt) - 1, UBound(Urn) - 1)
.SpecialCells(xlCellTypeBlanks).Font.Color = vbRed: .SpecialCells(xlCellTypeBlanks).Value = "O":
End With
With .Range("B3").Offset(, UBound(Urn) - 1).Resize(UBound(Urn) - 1, UBound(Urn) - 1)
.SpecialCells(xlCellTypeBlanks).Interior.ColorIndex = 15
End With
AddOutsideBorders .Range("A1").Resize(UBound(Dt) + 1, 1 + ((UBound(Urn) - 1) * 2))
With .Cells
.Columns.AutoFit
.HorizontalAlignment = xlCenter
.RowHeight = 25
End With
End With
End With
Application.ScreenUpdating = True
End Sub
Public Function AddOutsideBorders(rng As Range)
With rng.Borders
.LineStyle = xlContinuous
.Color = vbBlack
.Weight = xlThin
End With
End Function