我的VBScript代碼“下標超出范圍”時出現錯誤

Question

你能告訴我為什么我得到錯誤，因為下Subscript out of range- ArrParent嗎？ 當我使用MsgBox(Lbound(ArrParent)) -給我1時，當我使用MsgBox(Ubound(ArrParent)) -給我960。所以在下面的行中，我得到out of range錯誤。 Dic(ArrParent(Count))=Count+2查找下面的完整代碼：

碼

    Sub ParentPIDNumber(ArrParent,ob3,ob2,ob4)

        Dim Dic,DicItems,Dickeys
        Dim Count

        Set Dic = CreateObject("Scripting.Dictionary")

        Count=LBound(ArrParent)
        'MsgBox(ArrParent(Count))
        Do Until Count > UBound(ArrParent) - 1

           Dic(ArrParent(Count))=Count+2 'here Dictionary keys are holding the row numbers as their Items

        Count=Count+1
        Loop

        ParentChildBinding Dic,ob3,ob2,ob4

    End Sub
   Sub FileredOpenProcessToDel(ob3,ob2,ob4)

        Dim ColumnToFilter,TotalRows
        Dim rngFilter,cel,str,rangesToRemove,x 
        Dim strToRemove : strToRemove = ""
        Dim ArrParent

        objExcel1.ScreenUpdating = False
        objExcel1.Calculation = -4135  'xlCalculationManual
        ColumnToFilter=objExcel1.Application.WorksheetFunction.CountA(ob4.Rows(1)) - 1
        ob4.Range(ob4.Cells(1,ColumnToFilter),ob4.Cells(1,ColumnToFilter)).AutoFilter ColumnToFilter, "Open",,,True 

        'Dim rngFilter as Range
        Set rngFilter = objExcel1.Application.Intersect(ob4.UsedRange,ob4.UsedRange.Offset(1),ob4.Columns(1)).SpecialCells(12)'xlCellTypeVisible
           'MsgBox(rngFilter.Rows.Count)
           REM Do While 1=1
            REM 'Msgbox
           REM Loop
        'msgbox "Filtered range has " & rngFilter.Rows.Count & " rows."
            str=""
            For each cel in rngFilter

              str = str & (cel.row) & ":" & (cel.row) & "," 

            Next

                    rangesToRemove = Split(str,",")

                    For x = UBOUND(rangesToRemove)-1 To LBOUND(rangesToRemove) Step -1

                         strToRemove = strToRemove & rangesToRemove(x)

                            If Len(strToRemove) > 200 then

                                ob4.Range(strToRemove).delete'str & rangesToRemove(x) & ":" & rangesToRemove(x) & ","
                                strToRemove = ""

                            Else

                                strToRemove = strToRemove & ","

                            End If

                    Next
                    If len(strToRemove) > 0 then

                        strToRemove = Mid(strToRemove, 1, Len(strToRemove) - 1)
                        'strToRemove = Left(strToRemove, Len(strToRemove) -1)
                        ob4.Range(strToRemove).delete

                    End If

        ob4.AutoFilterMode = False
        objExcel1.ScreenUpdating = True
        objExcel1.Calculation = -4105   'xlCalculationAutomatic

        TotalRows=objExcel1.Application.WorksheetFunction.CountA(ob4.Columns(1))
        'MsgBox(TotalRows)
        ReDim ArrParent(TotalRows - 2)
        ArrParent=ob4.Range("A2:" & "A" & TotalRows).Value
        'Call to the subroutine
        ParentPIDNumber ArrParent,ob3,ob2,ob4

    End Sub

請在這里幫助我！

Answer 1

在這種情況下，您可以做的最好的事情是在單獨的腳本中提取錯誤代碼並在其中進行實驗，直到找到錯誤為止。

在您的情況下，我找不到錯誤，以下腳本沒有給出錯誤，但它跳過了數組的最后一個元素

ArrParent = Array(10, 20, 30)
Count=LBound(ArrParent)
Set Dic = CreateObject("Scripting.Dictionary")
Do Until Count > UBound(ArrParent) - 1
  Dic(ArrParent(Count))=Count+2
  Count=Count+1
Loop
for each key in Dic 
  wscript.echo key & ":" & Dic(key)
next

'10:2
'20:3

我沒有供您實驗的sourcearray，但是您可以這樣嘗試，為了避免索引超出范圍錯誤，可以使用“ for each”，如果不需要count變量，甚至可以迭代數組的最佳方法。

Count = 1
Set Dic = CreateObject("Scripting.Dictionary")
for each element in ArrParent
  Dic(element)=Count+2
  Count = Count+1
next

for each key in Dic 
  wscript.echo key & ":" & Dic(key)
next
'10:3
'20:4
'30:5