运行时错误'5'：无效的过程调用或参数

Question

我在附加到ActiveX命令按钮的Microsoft Excel 2010中编写了一些代码。该代码假设在电子表格中找到最后一行，将第一列添加到集合中并删除重复项，为目录创建一个新电子表格并列出集合中的每个唯一值并创建一个命名范围以用于另一个电子表格作为下拉列表。虽然截至昨天，我现在在标题中收到上述错误。下面是代码：

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”已经在字典中定义为“Exists”。不要重新发明车轮;）