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
你可以刪除所有不必要的代碼,讓問題留在原位,這樣這個例子是可讀的嗎? –
我除去了發生問題的地方都刪除了。設置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