2016-06-28 161 views
0

當我運行下面的代碼時,出現運行時錯誤'91':對象變量或塊變量未設置。它突出顯示了在set rng函數中的編號下面的編碼,任何人都知道我需要對代碼執行什麼操作才能使其不出錯?運行VBA代碼並得到運行時錯誤'91'

' 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 
+0

你可以刪除所有不必要的代碼,讓問題留在原位,這樣這個例子是可讀的嗎? –

+0

我除去了發生問題的地方都刪除了。設置rng =範圍(wsDataAll.Cells.Find(ListBox2.List(index),LookAt:= xlWhole).Offset(0,14),wsDataAll.Cells.Find( ListBox2.List(index),LookAt:= xlWhole).Offset(0,14).End(xlDown)) – cinstanl

回答

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 

例如。

+0

我試過了。你是對的,它沒有找到數據。我將索引更改爲1而不是0.它正在查找數據,但未計算總位置。 – cinstanl