Excel宏下标超出范围错误

时间:2011-09-26 18:24:44

标签: excel vba

我有以下宏,让If arr(0) <> opt Then arr(0) = VAL_DIFF

中的脚本超出范围错误

如果我看到它显示的那个数组的长度2.我不明白为什么我无法访问arr(0),据我所知,Array始终以0.I能够打印arr(1), arr(2)值。

下面的宏能够找到类似的记录并复制到sheet2.Here我也想在sheet1中用颜色突出显示。请帮帮我。

Option Base 1
Sub Tester()

    Const COL_ID As Integer = 1
    Const COL_SYSID As Integer = 2
    Const COL_STATUS As Integer = 4
    Const COL_OPTION As Integer = 3
    Const VAL_DIFF As String = "XXdifferentXX"

    Dim d As Object, sKey As String, id As String
    Dim rw As Range, opt As String, rngData As Range
    Dim rngCopy As Range, goodId As Boolean
    Dim FirstPass As Boolean, arr

        With Sheet1.Range("A1")
            Set rngData = .CurrentRegion.Offset(1).Resize( _
                             .CurrentRegion.Rows.Count - 1)
        End With
        Set rngCopy = Sheet1.Range("F2")

        Set d = CreateObject("scripting.dictionary")
        FirstPass = True

    redo:
        For Each rw In rngData.Rows

            sKey = rw.Cells(COL_SYSID).Value & "<>" & _
                   rw.Cells(COL_STATUS).Value

            If FirstPass Then
              'Figure out which combinations have different option values
              '  and at least one record with id=US or CHN
              id = rw.Cells(COL_ID).Value
              goodId = (id = "US" Or id = "CHN")
              opt = rw.Cells(COL_OPTION).Value

              If d.exists(sKey) Then
                  arr = d(sKey) 'can't modify the array in situ...
                  If arr(1) <> opt Then arr(1) = VAL_DIFF
                  If goodId Then arr(2) = True
                  d(sKey) = arr 'return [modified] array
              Else
                  d.Add sKey, Array(opt, goodId)
              End If

            Else
              'Second pass - copy only rows with varying options
              '  and id=US or CHN
              If d(sKey)(2) = VAL_DIFF And d(sKey)(1) = True Then
                  rw.Copy rngCopy
                  Set rngCopy = rngCopy.Offset(1, 0)
              End If
            End If

        Next rw
        If FirstPass Then
            FirstPass = False
            GoTo redo
        End If

    End Sub

2 个答案:

答案 0 :(得分:2)

停止使用模块顶部的Option Base 1。它似乎可以使事情变得更容易,但它最终只能造成混乱。我已经给你了解颜色范围的答案 - 请尝试查看并在发布之前试用它们。

答案 1 :(得分:0)

要检查数组的下限位置,请使用Lbound(arr)

另外,您没有将arr初始化为数组。像这样初始化它: Dim arr() As Variant

您还可以指定数组的较低维度和较高维度。 Dim arr(3 To 10) As Variant。这将创建一个从零位开始的7个元素的数组。我建议您通过Google搜索了解有关VBA中数组的更多信息。