[已解决]为什么在ReDim Preserve数组时会出现下标越界的错误？

gwfzh

为什么在ReDim Preserve数组时会出现下标越界的错误？

各位老师：定义数组时不就是确定上、下标界限吗？为什么在重定义时经常会出现下标越界的错误呢？如下面黄色字处又出现了下标越界的错误？

Sub yy()
    Dim i%, myrah&, arr(), arrah, jrr(), mr()
    Dim d, k, t, jgmx, jg1, j&, aa, x, sd$    ', d As New Dictionary
    Set d = CreateObject("Scripting.Dictionary")
    Sheet1.Activate
    r = [a65536].End(xlUp).Row
    arr = Range("a5:d" & r)
    m = 7
    ReDim Preserve jrr(1 To d.Count, 1 To 15)
    ReDim Preserve mr(1 To d.Count)
    For jjj = 1 To UBound(arr, 2)
        Set d = CreateObject("Scripting.Dictionary")
        For iii = 2 To UBound(arr, 1)
            If Not d.exists(arr(jjj, jjj)) Then
                d(arr(iii, jjj)) = arr(iii, 1)
            Else
                d(arr(iii, jjj)) = d(arr(iii, jjj)) & "," & arr(iii, 1)
            End If
        Next iii
        x = d.Count
        k = d.keys
        t = d.items
        k = d.keys
        t = d.items
        For ii = 0 To UBound(k)
            jgmx = 0: sd = ""
            t(ii) = Left(t(ii), Len(t(ii)))
            If InStr(t(ii), ",") > 0 Then
                aa = Split(t(ii), ",")
                jgmx = aa(1) - aa(0)
                sd = aa(0) & "~" & aa(1)
                For j = 2 To UBound(aa)
                    If aa(j) <> UBound(arr, 1) Then
                        jg1 = aa(j) - aa(j - 1)
                        If jg1 > jgmx Then
                            jgmx = jg1
                            sd = aa(j - 1) & "~" & aa(j)
                        End If
                    Else
                        jg1 = UBound(arr, 1) - aa(j)
                        If jg1 > jgmx Then
                            jgmx = jg1
                            sd = aa(j) & "~" & UBound(arr, 1)
                        End If
                    End If
                Next j
            Else
                If t(0) <> UBound(arr, 1) Then
                    jgmx = UBound(arr, 1) - t(0)
                    sd = t(0) & "~" & UBound(arr, 1)
                Else
                    jgmx = 0
                    sd = UBound(arr, 1) & "~" & UBound(arr, 1)
                End If
            End If
        Next ii
        jrr(i, 10) = jgmx
        jrr(i, 11) = sd
        'd.RemoveAll
        'Next
        '[aH5].Resize(UBound(arrah), 13) = jrr
        Sheet1.Cells(Row - d.Count, m).Resize(d.Count, 1) = Application.Transpose(d.keys)
        Sheet1.Cells(Row - d.Count, m + 1).Resize(d.Count, 1) = Application.Transpose(d.items)
        Cells(Row - d.Count - 1, m + 1).Resize(1, 12) = jrr
        m = m + 16
        Set d = Nothing
    Next jjj

End Sub

1i268rA4.zip (74.49 KB, 下载次数: 0)

2010-8-24 11:11 上传

点击文件名下载附件
为什么在ReDim Preserve数组时会出现下标越界的错误？

[此贴子已经被作者于2010-8-24 11:11:18编辑过]

最佳答案

月排行榜 / 总排行榜

amulee

2010-8-24 13:07

aa数组是个字符串类型的数组，不能相减，可以改成：jgmx = Val(aa(1)) - Val(aa(0))

跳转到最佳答案楼层

amulee

只能改最后一维。

你的数组还未初始化，不能用Preserve关键字。

先用Redim吧

gwfzh

QUOTE:

以下是引用amulee在2010-8-24 10:47:00的发言：

只能改最后一维。

你的数组还未初始化，不能用Preserve关键字。

先用Redim吧

请amulee老师！再帮助

谢谢amulee老师！按照你的要求已将ReDim Preserve 修改为ReDim ，并将错误的row改为r后，在‘   jgmx = aa(1) - aa(0)
’（红色字处）出现了类型不匹配（    aa(0）="")的错误？希望amulee老师能够帮忙修改一下，谢谢了
）

Sub yy()
    Dim i%, myrah&, arr(), arrah, jrr(), mr()
    Dim d, k, t, jgmx, jg1, j&, aa, x, sd$    ', d As New Dictionary
    Set d = CreateObject("Scripting.Dictionary")
    Sheet1.Activate
    r = [a65536].End(xlUp).Row
    arr = Range("a5:d" & r)
    m = 7
    ' ReDim Preserve jrr(1 To 15, 1 To d.Count)

    ReDim jrr(0 To d.Count, 1 To 15)
    ReDim Preserve mr(0 To d.Count)
    For jjj = 1 To UBound(arr, 2)
        Set d = CreateObject("Scripting.Dictionary")
        For iii = 2 To UBound(arr, 1)
            If Not d.exists(arr(jjj, jjj)) Then
                d(arr(iii, jjj)) = arr(iii, 1)
            Else
                d(arr(iii, jjj)) = d(arr(iii, jjj)) & "," & arr(iii, 1)
            End If
        Next iii
        x = d.Count
        k = d.keys
        t = d.items
        For ii = 0 To UBound(k)
            jgmx = 0: sd = ""
            t(ii) = Left(t(ii), Len(t(ii)))
            If InStr(t(ii), ",") > 0 Then
                aa = Split(t(ii), ",")
                jgmx = aa(1) - aa(0)
                sd = aa(0) & "~" & aa(1)
                For j = 2 To UBound(aa)
                    If aa(j) <> UBound(arr, 1) Then
                        jg1 = aa(j) - aa(j - 1)
                        If jg1 > jgmx Then
                            jgmx = jg1
                            sd = aa(j - 1) & "~" & aa(j)
                        End If
                    Else
                        jg1 = UBound(arr, 1) - aa(j)
                        If jg1 > jgmx Then
                            jgmx = jg1
                            sd = aa(j) & "~" & UBound(arr, 1)
                        End If
                    End If
                Next j
            Else
                If t(0) <> UBound(arr, 1) Then
                    jgmx = UBound(arr, 1) - t(0)
                    sd = t(0) & "~" & UBound(arr, 1)
                Else
                    jgmx = 0
                    sd = UBound(arr, 1) & "~" & UBound(arr, 1)
                End If
            End If
        Next ii
        jrr(i, 10) = jgmx
        jrr(i, 11) = sd
        'd.RemoveAll
        'Next
        '[aH5].Resize(UBound(arrah), 13) = jrr
        Sheet1.Cells(r - d.Count, m).Resize(d.Count, 1) = Application.Transpose(d.keys)
        Sheet1.Cells(r - d.Count, m + 1).Resize(d.Count, 1) = Application.Transpose(d.items)
        Cells(r - d.Count - 1, m + 1).Resize(1, 12) = jrr
        m = m + 16
        Set d = Nothing
    Next jjj

End Sub

VpBHGh2R.zip (74.49 KB, 下载次数: 5)

2010-8-24 11:30 上传

点击文件名下载附件
为什么在ReDim Preserve数组时会出现下标越界的错误？

amulee

aa数组是个字符串类型的数组，不能相减，可以改成：jgmx = Val(aa(1)) - Val(aa(0))