下標超出范圍VBA Excel數組

Question

我有這段代碼可以消除去符號化層次結構表中的所有異常。 當我嘗試使用一百行記錄（可能大約200到300條記錄）運行此宏時，它工作得很好。 但是，當我嘗試對所有行（大約18,000行）運行宏時，它將返回“下標超出范圍”錯誤。 我不確定代碼有什么問題，因為它似乎可以在數百行中正常工作。 我正在使用MS Excel 2010版本。 任何幫助將不勝感激，非常感謝。

這是我的工作代碼：

    Option Explicit

Sub EliminateAnomaliesDH()
Sheets("Denorm Hier").Select
Range("A1").Select
Dim iCtr As Integer
Dim arr As Variant

iCtr = 2

While Range("B" & iCtr).Value <> ""
arr = Split(Range("B" & iCtr).Value, "[")
arr = Split(arr(1), "]")

Select Case arr(0)
    Case "L1"
        Range("F" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L2"
        Range("H" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L3"
        Range("J" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L4"
        Range("L" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L5"
        Range("N" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L6"
        Range("P" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L7"
        Range("R" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L8"
        Range("T" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L9"
        Range("V" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L10"
        Range("X" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L11"
        Range("Z" & iCtr & ":AB" & iCtr & "").Value = ""
    Case "L12"
        Range("AB" & iCtr & ":AB" & iCtr & "").Value = ""
End Select

iCtr = iCtr + 1
Wend

Sheets("Instructions").Select
MsgBox "Successfully removed all anomalies of the Denormalized hierarchy Table"
End Sub

Answer 1

即使您沒有提到出現錯誤的行，也很明顯。 錯誤很可能就在網上

arr = Split(arr(1), "]")

原因很簡單。 因為單元格沒有“ [”，所以分割后就沒有ar(1) 。

這是重現該錯誤的非常簡單的方法。

Sub sample()
    Dim sString As String
    Dim myar

    sString = "Blah Blah"

    myar = Split(sString, "]")

    myar = Split(myar(1), "[") '<~~ Error here

    Debug.Print myar(0)
End Sub

為確保您沒有收到錯誤，請使用INSTR()檢查[或]存在，然后將其拆分。

例如

    If InStr(1, sString, "]") Then
        myar = Split(sString, "]")
    End If

評論的跟進

我重寫了您的代碼。 這是您要嘗試的嗎？ 請注意，我尚未對其進行測試，因此如果您遇到任何錯誤，請告訴我。 我也對相關部分的代碼進行了注釋。

Sub EliminateAnomaliesDH()
    Dim ws As Worksheet
    Dim lRow As Long, i As Long
    Dim tempString As String, sString As String

    Set ws = ThisWorkbook.Sheets("Denorm Hier")

    With ws
        '~~> Get the last row which has data in Col B
        lRow = .Range("B" & .Rows.Count).End(xlUp).Row

        '~~> Loop through cells in column B
        For i = 2 To lRow
            sString = .Range("B" & i).Value

            '~~> Check if the cell has both "[" and "]"
            If InStr(1, sString, "[") And InStr(1, sString, "]") Then
                tempString = Split(.Range("B" & i).Value, "[")(1)
                tempString = Split(tempString, "]")(0)

                '~~> This required so that we do an exact match
                '~~> For example, "  l1", "  l1   ", "   L1" etc
                '~~> becomes "L1"
                tempString = UCase(Trim(tempString))

                Select Case tempString
                    Case "L1": .Range("F" & i & ":AB" & i & "").ClearContents
                    Case "L2": .Range("H" & i & ":AB" & i & "").ClearContents
                    Case "L3": .Range("J" & i & ":AB" & i & "").ClearContents
                    Case "L4": .Range("L" & i & ":AB" & i & "").ClearContents
                    Case "L5": .Range("N" & i & ":AB" & i & "").ClearContents
                    Case "L6": .Range("P" & i & ":AB" & i & "").ClearContents
                    Case "L7": .Range("R" & i & ":AB" & i & "").ClearContents
                    Case "L8": .Range("T" & i & ":AB" & i & "").ClearContents
                    Case "L9": .Range("V" & i & ":AB" & i & "").ClearContents
                    Case "L10": .Range("X" & i & ":AB" & i & "").ClearContents
                    Case "L11": .Range("Z" & i & ":AB" & i & "").ClearContents
                    Case "L12": .Range("AB" & i & ":AB" & i & "").ClearContents
                End Select
            End If
        Next i
    End With
    MsgBox "Successfully removed all anomalies of the Denormalized hierarchy Table"
End Sub