VBAコードを実行してランタイムエラーが発生しました '91'

Question

次のコードを実行すると、実行時エラー '91'が表示されます：オブジェクト変数またはWithブロック変数が設定されていません。 set rng関数の数値の下のコーディングを強調表示します。エラーが出ないようにするためにコードに何をする必要があるのか​​誰にもわかりますか？

' Global and Public Variables 
Dim i As Integer 
Dim FilterProducts() As String 

'Option Explicit 

Private Sub btnOK_Click() 

Application.ScreenUpdating = False 

' Declare variables: 
Dim rng As Range 
Dim index As Integer 
Dim totalLocations As Integer 
totalLocations = 0 

' Check to see if at least one Product is selected: 
If ListBox2.ListCount = 0 Then 

    MsgBox "Please select at least one product line from the list!", vbCritical, "Error" 

Else 

    ' Filter out the pivot table based on the selections. 

    ' 1) Find out the size remaining in ListBox1, and assign that to the size of the array. 
    ReDim FilterProducts(ListBox1.ListCount) 

    ' 2) Fill up the values in the array with the ones remaining in the List Box1. 
    For index = 0 To ListBox1.ListCount - 1 

     FilterProducts(index) = ListBox1.List(index) 

    Next 

    ' 3) Filter out the pivot table on wsDbPGPivot to only the values selected: 
    FilterChartOnProducts ("Chart 1") 
' FilterChartOnProducts ("Chart 2") 
' FilterChartOnProducts ("Chart 3") 
' FilterChartOnProducts ("Chart 4") 
' FilterChartOnProducts ("Chart 5") 
' FilterChartOnProducts ("Chart 6") 
' FilterChartOnProducts ("Chart 7") 
' FilterChartOnProducts ("Chart 8") 
' FilterChartOnProducts ("Chart 9") 
' FilterChartOnProducts ("Chart 10") 
' FilterChartOnProducts ("Chart 11") 
' FilterChartOnProducts ("Chart 12") 
' FilterChartOnProducts ("Chart 13") 
' FilterChartOnProducts ("Chart 14") 
' FilterChartOnProducts ("Chart 15") 
' FilterChartOnProducts ("Chart 16") 
' FilterChartOnProducts ("Chart 17") 
' 'FilterChartOnProducts ("Chart 18") 
' FilterChartOnProducts ("Chart 22") 

    ' 4) Update Number of Locations: 
    For index = 0 To ListBox2.ListCount - 1 

     ' Find the range for the current Product: 
     wsDataAll.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:=ListBox2.List(index) 
     Set rng = Range(wsDataAll.Cells.Find(ListBox2.List(index), LookAt:=xlWhole).Offset(0, 14), wsDataAll.Cells.Find(ListBox2.List(index), LookAt:=xlWhole).Offset(0, 14).End(xlDown)) 

     totalLocations = totalLocations + CountUnique(rng) 

    Next 

    ' 5) Write the results: 
    wsDistributorbyProductGroup.Range("S8").Value = totalLocations 

    ' 6) Clear the filter from the table: 
    wsDataAll.ListObjects("Table1").Range.AutoFilter Field:=1 

End If 

' Go back to main worksheet 
wsDistributorbyProductGroup.Activate 

Unload Product 

End Sub 
Sub FilterChartOnProducts(NameOfChart As String) 

Dim index As Integer 

' First make sure all of the current filters are reset: 
wsDbPGPivot.ChartObjects(NameOfChart).Activate 
ActiveChart.PivotLayout.PivotTable.PivotFields("PRODUCT_GROUP").ClearAllFilters 

' Then, go through the Products not selected and make them not visible (or filtered out): 
For index = 0 To UBound(FilterProducts) - 1 

    ActiveChart.PivotLayout.PivotTable.PivotFields("PRODUCT_GROUP").PivotItems(FilterProducts(index)).Visible = False 

    Next 

End Sub 
Public Function CountUnique(rng As Range) As Integer 
    Dim dict As Dictionary 
    Dim cell As Range 
    Set dict = New Dictionary 
    For Each cell In rng.Cells 
     If Not dict.Exists(cell.Value) Then 
      dict.Add cell.Value, 0 
     End If 
    Next 
    CountUnique = dict.Count 
End Function 
Private Sub CheckBox1_Click() 
If CheckBox1.Value = True Then 
    For i = 0 To ListBox1.ListCount - 1 
     ListBox1.Selected(i) = True 
    Next i 
End If 

If CheckBox1.Value = False Then 
    For i = 0 To ListBox1.ListCount - 1 
     ListBox1.Selected(i) = False 
    Next i 
End If 

End Sub 

Private Sub CheckBox2_Click() 
If CheckBox2.Value = True Then 
    For i = 0 To ListBox2.ListCount - 1 
     ListBox2.Selected(i) = True 
    Next i 
End If 

If CheckBox2.Value = False Then 
    For i = 0 To ListBox2.ListCount - 1 
     ListBox2.Selected(i) = False 
    Next i 
End If 

End Sub 


Private Sub CommandButton1_Click() 

For i = 0 To ListBox1.ListCount - 1 
    If ListBox1.Selected(i) = True Then ListBox2.AddItem ListBox1.List(i) 
Next i 

For i = Me.ListBox1.ListCount - 1 To 0 Step -1 
    If ListBox1.Selected(i) = True Then 
    Me.ListBox1.RemoveItem i 
    End If 
Next i 

End Sub 


Private Sub CommandButton2_Click() 

For i = 0 To ListBox2.ListCount - 1 
    If ListBox2.Selected(i) = True Then ListBox1.AddItem ListBox2.List(i) 
Next i 

For i = ListBox2.ListCount - 1 To 0 Step -1 
    If ListBox2.Selected(i) = True Then 
    ListBox2.RemoveItem i 
    End If 
Next i 

End Sub 

Private Sub OptionButton1_Click() 
ListBox1.MultiSelect = 0 
ListBox2.MultiSelect = 0 

End Sub 

Private Sub OptionButton2_Click() 
ListBox1.MultiSelect = 1 
ListBox2.MultiSelect = 1 

End Sub 

Private Sub OptionButton3_Click() 
ListBox1.MultiSelect = 2 
ListBox2.MultiSelect = 2 

End Sub 

Private Sub UserForm_Initialize() 
    Dim myList As Collection 
    Dim myRange As Range 
    Dim ws As Worksheet 
    Dim myVal As Variant 


    Set ws = ThisWorkbook.Sheets("Locations") 
    Set myRange = ws.Range("Q2", ws.Range("Q2").End(xlDown)) 
    Set myList = New Collection 

    On Error Resume Next 
    For Each myCell In myRange.Cells 
    myList.Add myCell.Value, CStr(myCell.Value) 
    Next myCell 
    On Error GoTo 0 

    For Each myVal In myList 
    Me.ListBox1.AddItem myVal 
    Next myVal 


OptionButton1.Value = True 

End Sub 

Answer 1

あなたが見つかった範囲のプロパティを試してみて、使用する前に、検索値が実際に発見されたことをテストする必要があります。たとえば

Set rng = wsDataAll.Cells.Find(ListBox2.List(index), LookAt:=xlWhole) 
If not rng Is Nothing then 
    Set rng = Range(rng.Offset(0, 14), rng.Offset(0, 14).End(xlDown)) 
Else 
    Msgbox ListBox2.List(index) & " not found" 
    Exit Sub 
End If 

。