使用ReDim Preserve 调整大小时候，提示下标越界

grayson

求助，当x=2时候就提示下标越界，ReDim Preserve brr1(1 To x, 1 To UBound(brr, 2))就提示下标越界，ReDim Preserve brr1(x, UBound(brr, 2))也是下标越界
本意是筛选数组中的某一元素后，形成新的数组
不知道是否还有更好的方法

Set d = CreateObject("scripting.dictionary")
    r = Cells(Rows.Count, 4).End(xlUp).Row     
    arr = Range("D2:D" & r)         
    For i = 1 To UBound(arr)   
        d(arr(i, 1)) = ""     
    Next
    arr() = d.keys
    n = UBound(arr)
    brr() = Range("A2:AC" & r)
    x = 0
    For i = 0 To n
        For m = 1 To UBound(brr)
            y = 0
            If brr(m, 4) = arr(i) Then
                x = x + 1
                ReDim Preserve brr1(1 To x, 1 To UBound(brr, 2))
                For j = 1 To UBound(brr, 2)
                    y = y + 1
                    brr1(x, y) = brr(m, j)
                Next
            End If
        Next
    Next

liulang0808

ReDim Preserve brr1(1 To x, 1 To UBound(brr, 2))
这个只能改变最后一个维度的上届，
楼主这样设置看看对应的数组范围是否变化吧

grayson

liulang0808 发表于 2023-6-25 17:07
ReDim Preserve brr1(1 To x, 1 To UBound(brr, 2))
这个只能改变最后一个维度的上届，
楼主这样设置看 ...

恩，是的，当x的值是1时可以运行，当x变成2时候就不行了，但是如果我把x变量改成固定值，比如1 to 2 或者 1 to 500都不会出现下标越界的问题，但是改成变量x就出现问题了，不知道是什么原因

盼盼198310

最好是定义一个跟原数组一样的数组,符合条件的计数器加一,数据装入新数组

xunanming

如果就想用preserver的方式,就将ReDim Preserve brr1(1 To x, 1 To UBound(brr, 2))改为
ReDim Preserve brr1(1 To UBound(brr, 2),1 to x),输出时需要transpose.
或者直接在brr()下面redim一个数组 redim brr1(1 to ubound(brr),1 to ubound(brr,2)),可直接输出.

grayson

xunanming 发表于 2023-6-25 18:18
如果就想用preserver的方式,就将ReDim Preserve brr1(1 To x, 1 To UBound(brr, 2))改为
ReDim Preserve b ...

哦，我对最后一维的理解不对，才导致这样的错误，感谢！！

opiona

ReDim Preserve  的理解
ReDim Preserve ARX(1 TO INTA,1 TO INTB)  INTA 是固定值, INTB 可以变化
如果想要INTB是固定值, 需要INTA 是变化的
则先将数组声明为: ReDim Preserve  ARX(1 TO INTB,1 TO INTA)
代码中和常规的第一维度,第二维度是相反的
获得最终结果后  使用transpose 进行转置 就变成 ARX(1 TO INTA,1 TO INTB)  的了

注意 如果变化值 INTA,或INTB 比较大 例如:3W以上, 则运行会非常慢
这时 一般先将  INTA,或INTB 设置为最大值 或比可能最大值更大
使用第三个变量 INTX 记录行数
例如: INTX=0  
给一行赋值时:  
INTX=INTX+1   
ARX(INTX,2)=xxxx

最后声明一个数组  redim TRX(1 TO INTX,1 TO UBOUND(ARX,2)
将有效行赋值给TRX 即可
for I=1 TO INTX
   FOR ICOL=1 TO UBOUND(ARX,2)
      TRX(I,ICOL)=ARX(I,ICOL)
   NEXT
NEXT

grayson

opiona 发表于 2023-6-25 21:21
ReDim Preserve  的理解
ReDim Preserve ARX(1 TO INTA,1 TO INTB)  INTA 是固定值, INTB 可以变化
如果 ...

恩，非常感谢！我差不多也是这样做的！
    Set d = CreateObject("scripting.dictionary")  
    r = Cells(Rows.Count, 4).End(xlUp).Row      
    arr = Range("D2:D" & r)        
    For i = 1 To UBound(arr)   
        d(arr(i, 1)) = ""     
    Next
    arr() = d.keys
    n = UBound(arr)
    brr() = Range("A2:AC" & r)
   
    For i = 0 To n
        For m = 1 To UBound(brr)
            If brr(m, 4) = arr(i) Then
                x = WorksheetFunction.CountIfs(Range("d2:d" & r), arr(i))
                ReDim Preserve brr1(1 To x, 1 To UBound(brr, 2))
                    y = 0
                    For j = 1 To UBound(brr, 2)
                        y = y + 1
                        brr1(m, y) = brr(m, j)
                    Next
            End If
        Next
    Next

opiona

grayson 发表于 2023-6-25 22:20
恩，非常感谢！我差不多也是这样做的！
    Set d = CreateObject("scripting.dictionary")  
    r =  ...

              x = WorksheetFunction.CountIfs(Range("d2:d" & r), arr(i))
                ReDim Preserve brr1(1 To x, 1 To UBound(brr, 2))

你这里 X 是变化值, 应该是运行不起来的

michael82

opiona 发表于 2023-6-25 21:21
ReDim Preserve  的理解
ReDim Preserve ARX(1 TO INTA,1 TO INTB)  INTA 是固定值, INTB 可以变化
如果 ...

学些了，多谢无私分享！