Ошибка времени выполнения '5': Неверный вызов или аргумент процедуры

Question

Я написал код в Microsoft Excel 2010, который прикреплен к командной кнопке ActiveX. Код должен найти последнюю строку в электронной таблице, добавить первый столбец в коллекцию и удалить дубликаты, создать новую таблицу для оглавления и отобразить каждое уникальное значение из коллекции и создать именованный диапазон, который будет использоваться с другую таблицу в виде раскрывающегося списка. Хотя по состоянию на вчерашний день я получаю выше ошибку в названии. Ниже приведен код:

Option Explicit 
Private Sub btnCloseShipsList_Click() 
'=============================================================================================== 
'Description: Builds the List Data Validation drop-down menus and hides all sheets except [SITE, _ 
    SYSTEM or INVESTIGATION REQ'D] 
'Originally written by: Troy Pilewski 
'Date: 2016-01-20 
'=============================================================================================== 
Dim i As Integer 
Dim xWs As Worksheet, xWb As Workbook, rng As Range, ws As Worksheet, wsHull As Worksheet 
Dim lngLastRow As Long, lngShipRow, lngLastHull As Long 
Dim xTitle As String, strShips() As String 
Dim vntShips As Variant, Ships As Collection 


'Turn off application events to speed up code 
With Application 
    .DisplayAlerts = False 
    .ScreenUpdating = False 
End With 

'Assigns a string to the title variable 
xTitle = "TABLE OF CONTENTS" 

'Unhides TABLE OF CONTENTS sheet and deletes it to recreate a new one 
Application.Sheets(xTitle).Visible = xlSheetVisible 
Application.Sheets(xTitle).Delete 
Application.Sheets.Add Before:=Worksheets(1) 

'Sets the Datasheet as the active worksheet 
Set xWs = Application.ActiveSheet 
Set wsHull = Application.Sheets("HULL_TYPES") 

xWs.Name = xTitle 

'Creates a title row 
With xWs.Cells(1, 1) 
    .Value = "Sheet Names" 
    .Font.Bold = True 
End With 
'Creates a generic placeholder 
With xWs.Cells(2, 1) 
    .Value = "SHIPNAME (CLASS)" 
End With 

'Determine the last row with values 
Set xWs = Application.Sheets("SHIPS") 

'Call DeleteEntireRow 

'Call SystemNamePropigation 

lngLastRow = xWs.Range("A:A").Find(_ 
    What:="*", _ 
    After:=xWs.Range("A1"), _ 
    Lookat:=xlByRows, _ 
    SearchOrder:=xlByRows, _ 
    SearchDirection:=xlPrevious _ 
).Row 
lngLastHull = wsHull.Range("A:A").Find(_ 
    What:="*", _ 
    After:=wsHull.Range("A1"), _ 
    Lookat:=xlByRows, _ 
    SearchOrder:=xlByRows, _ 
    SearchDirection:=xlPrevious _ 
).Row 

'Creates and adds each Ship to a collection 
If lngLastRow > 2 Then 
    vntShips = xWs.Range("A3:A" & lngLastRow).Value 
    Set Ships = New Collection 

    'Loop through the array of all Ship values (duplicates will be in this list) 
    For lngShipRow = LBound(vntShips, 1) To UBound(vntShips, 1) 

     'Check the first unique value of a Ship 
     If KEYISINCOLLECTION(Ships, CStr(vntShips(lngShipRow, 1))) = False Then 

      'Add the first unique Ship to the collection 
      Ships.Add CStr(vntShips(lngShipRow, 1)), CStr(vntShips(lngShipRow, 1)) 
     End If 
    Next lngShipRow 

    'Converts collection to a string 
    With Ships 
     ReDim strShips(.Count) As String 
    ' MsgBox UBound(strShips) 
     For i = 1 To .Count 
      strShips(i) = .Item(i) 
     Next i 
    End With 
End If 

For Each ShipRecord In xWs.Range("F3:F" & lngLastRow) 
    If ShipRecord = vbNullString And Range(ShipRecord.Address).Offset(0, -1) = vbNullString Then 
     'MsgBox Range(ShipRecord.Address).Offset(0, -2) & " has No Scan Data" 
    ElseIf ShipRecord = vbNullString And Range(ShipRecord.Address).Offset(0, -1) > Now() - 1 Then 
     Range(ShipRecord.Address) = "0" 
    End If 
Next 

'Loops through worksheet and lists them in a column and adds a hyperlink to the sheet 
Set xWs = Application.Sheets("TABLE OF CONTENTS") 

If lngLastRow > 2 Then 
    For i = LBound(strShips) + 1 To UBound(strShips) 
     With wsHull 
      ReDim HullTypes(lngLastHull) 
      HullTypes = .Range("A3:B" & lngLastHull).Value 
     End With 
     With Application.WorksheetFunction 
      Dim HullNumber As String 
      HullNumber = .Index(HullTypes, .Match(strShips(i), wsHull.Range("A3:A" & lngLastHull)), 2) 
     End With 
     With xWs.Cells(i + 2, 1) 
      .Value = strShips(i) & Chr(32) & "(" & HullNumber & ")" 
    '  .Hyperlinks.Add anchor:=Cells(i + 1, 1), Address:="", _ 
    '  SubAddress:="'" & Worksheets(i).name & "'!$A$1" 
     End With 
    ' MsgBox Cells(i + 2, 1) 
    Next 
    'For i = 2 To Worksheets.count - 3 
    ' With Cells(i + 1, 1) 
    '  .value = Worksheets(i + 3).name 
    '  .Hyperlinks.Add anchor:=Cells(i + 1, 1), Address:="", _ 
    '  SubAddress:="'" & Worksheets(i).name & "'!$A$1" 
    ' End With 
    'Next 
End If 

'Sets the Datasheet as the active worksheet 
Set xWb = ActiveWorkbook 

'Determine the last row with values 
Set xWs = Application.Sheets("TABLE OF CONTENTS") 
lngLastRow = xWs.Range("A:A").Find(_ 
    What:="*", _ 
    After:=xWs.Range("A1"), _ 
    Lookat:=xlByRows, _ 
    SearchOrder:=xlByRows, _ 
    SearchDirection:=xlPrevious _ 
).Row 

'Sets the range for the Named Object 
Set rng = xWs.Range("$A$1:$A$" & lngLastRow - 1).Offset(1, 0) 

'MsgBox CStr(rng) 

'Creates a Named Object Range and assignes its range 
xWb.Names.Add Name:="SheetList", RefersTo:=rng 

'Changes the column width to autofit to the contents of the column 
xWs.Cells(1, 1).EntireColumn.AutoFit 

'loops through the all worksheets and hides them unless they are SITE, SYSTEM or INVESTIGATION REQ'D 
For Each ws In ActiveWorkbook.Worksheets 
    If ws.Name = "TABLE OF CONTENTS" Then 
     ws.Visible = xlSheetVeryHidden 
    ElseIf ws.Name = "HULL_TYPES" Then 
     ws.Visible = xlSheetVeryHidden 
    ElseIf ws.Name = "SYSTEM_LIST" Then 
     ws.Visible = xlSheetVeryHidden 
    ElseIf ws.Name = "SITE" Then 
     ws.Visible = xlSheetVisible 
    ElseIf ws.Name = "SYSTEM" Then 
     ws.Visible = xlSheetVisible 
    ElseIf ws.Name = "INVESTIGATION REQ'D" Then 
     ws.Visible = xlSheetVisible 
    Else 
     ws.Visible = xlSheetHidden 
    End If 
Next ws 

'Application.Sheets(1).Visible = False 
End Sub 

Public Function KEYISINCOLLECTION(CollTemp As Collection, KeyToCheck As String) As Boolean 
'=============================================================================================== 
'Description: Validates the selection is not already in the collection 
'Originally written by: Zack Barresse 
'Date: 2014-09-15 
'=============================================================================================== 

    On Error Resume Next 
    KEYISINCOLLECTION = CBool(Not IsEmpty(CollTemp(KeyToCheck))) 
    On Error GoTo 0 
End Function 

Answer 1

Вы могли бы отключить обработчик ошибок, установив " переломить все ошибки ".

В окне VBA, перейдите Tools ->Options ->General ->Error Trapping и выберите Break on Unhandled Errors.

Answer 2

Ваша KEYISINCOLLECTION() функция работает для меня

вы можете попробовать это небольшое изменение кода

Public Function KEYISINCOLLECTION(CollTemp As Collection, KeyToCheck As String) As Boolean 
    Dim x As Variant 
    On Error Resume Next 
    x = CollTemp(KeyToCheck) 
    On Error GoTo 0 
    KEYISINCOLLECTION = Not IsEmpty(x) 
End Function 

Answer 3

Для меня, это работает, как это, там может быть только две возможные причины:
1. Одна вещь, которую я заметил, если вы повторно запустить код, и вы никогда не set Ships = Nothing, когда закончил первый раз это может привести к странным поведение.
2. До тех пор, пока это условие не выполняется, это не должно быть проблемой If KEYISINCOLLECTION(Ships, CStr(vntShips(lngShipRow, 1))) = False Then Я видел, что это произошло из диапазона, может быть, есть ошибка формулы в этом диапазоне?
OT: Есть несколько возможностей, которые я видел. Если возможно, почему вы устанавливаете range.value как серию коллекций вместо диапазона, а затем выполняете .value по мере необходимости в коде? 2. Почему вы не используете словарь вместо коллекции? Эта функция «KEYISINCOLLECTION» уже определена как «существует» в словаре. Не изобретайте колесо;)