32、[VBA入门到放弃笔记] 动态的数组

• 动态的数组事先是没有设置大小的。
• 定义动态的数组首先要声明，Dim arr()，然后用Redim命令来设置数组的大小。

Sub vv()
    Dim arr(), i As Long
    ReDim arr(1 To 10)'设置数组大小，一维数组，10个元素。
    For i = 1 To 10
        arr(i) = i
    Next
    Range("a1").Resize(UBound(arr), 1) = Application.Transpose(arr)
End Sub

Sub vv()
    Dim arr(), i As Long
    ReDim arr(1 To 10, 1 To 2) '设定数组大小
    For i = 1 To 10
        arr(i, 1) = i
        arr(i, 2) = i * 100
    Next
    Range("a1").Resize(UBound(arr), 2) = arr
End Sub

---

• 数组的扩展
• Redim Preserve

Sub vv()
    Dim arr(), i As Long
    For i = 1 To 10
    ReDim Preserve arr(1 To i)
        arr(i) = i
    Next
    Range("a1").Resize(UBound(arr), 1) = Application.Transpose(arr)
End Sub

• 当i=1，arr（1 to 1），arr(1)=1
• 当i=2，arr（1 to 2）,arr(1)=1,arr(2)=2
  ......如此类推

Paste_Image.png

• ReDim Preserve每次扩展数组的时候，都会保留前面的数据，如i=2时，并不会删除arr(1)这个元素的数据,类似滚雪球，越滚越大。
• Redim和ReDim Preserve的区别是：Redim是清空数组，再设置数组大小，并不保留原有的数据，ReDim Preserve是保留原有数据，扩张‘地盘‘。

Sub cc()
    Dim arr(), i As Long
    For i = 1 To 10
    ReDim arr(1 To i)
        arr(i) = i
    Next
    Range("a1").Resize(UBound(arr), 1) = Application.Transpose(arr)
End Sub

• 二维数组的扩展只能扩展其第二维，要将上的代码cc改为二维数组，如下

Sub kk()
    Dim arr(), i As Long
    For i = 1 To 10
    ReDim Preserve arr(1 To 1, 1 To i)
        arr(1, i) = i
    Next
    Range("a1").Resize(UBound(arr, 2), 1) = Application.Transpose(arr)
End Sub

• 先将二维数组设定为【1行 i 列】的数组，然后转置为 【 i 行1列 】的数值输出到单元格。

---

• Application.Transpose的局限
• 当数据量比较少的时候，Application.Transpose能将数据都转置。
• 当数据量超过65536行，或254列时，会超出Application.Transpose的极限，出问题。
• Application.Transpose效率较低。
• 如下面代码及其运行结果（图片）

Sub kk()
    Dim arr(), i As Long
    ReDim arr(1 To 65537)
    For i = 1 To UBound(arr)
        arr(i) = i
    Next
    Range("a1").Resize(UBound(arr), 1) = Application.Transpose(arr)
End Sub

出错了

• 处理方法：
• 1、声明一个足够大的空数组，往里面填装数据。比如，预计数据条数有1000条（不确定），那么就声明一个10000行N列的二维数组，然后用计数器计算条数，假如有K条，则将数组在K行这个地方一刀切开两端，将有数据的一端输出到工作表。
• 2、这种方法往往比redim preserve更方便和容易理解，也更有效率。
• 3、当然，实际情况下，可灵活结合使用。

【练习】提取销售额大于等于500的部门。

提取数据

• 1 Redim Presever写法

    Dim arr, brr()
    arr = Range("a1").CurrentRegion
    For i = 2 To UBound(arr)
        If arr(i, 2) >= 500 Then
            k = k + 1
            ReDim Preserve brr(1 To 2, 1 To k) '2行K列的数组
            brr(1, k) = arr(i, 1) '提取符合条件的数据，这是部门
            brr(2, k) = arr(i, 2) '销售额
        End If
    Next
    Range("g1").Resize(2, k) = brr '未转置前的数据（数组brr原来的样子)
    Range("d2").Resize(k, 2) = Application.Transpose(brr) '转置后的数据
End Sub

Paste_Image.png

• range("g1:o2")区域转置后的样子，可以手工操作: 复制--转置

  
  
  

  Paste_Image.png

• 2 声明一个足够大的数组写法

Sub ff1()
    Dim arr, brr()
    arr = Range("a1").CurrentRegion
    '设置brr和arr一样大小,因为是提取数据操作，数据条数不可能超过arr的条数
    ReDim brr(1 To UBound(arr), 1 To 2)
    For i = 2 To UBound(arr)
        If arr(i, 2) >= 500 Then
            k = k + 1
'提取符合条件的数据放到数组brr
            brr(k, 1) = arr(i, 1) '提取符合条件的数据，这是部门
            brr(k, 2) = arr(i, 2) '销售额
        End If
    Next
    Range("d2").Resize(k, 2) = brr '直接输出数据
End Sub

Paste_Image.png

• 数组arr和brr一样大小，从arr中提取符合条件的数据，遍历的时候，发现1条就计数1条，第1条数据放在brr第一行，第2条数据放在brr第2行，第3条数据放在brr第3行.....依次操作，直到完毕。
• 然后用计数的变量K值来截取brr的条目数，放到工作表中。见代码中的 Resize(k, 2)。
• 这种方式比ReDim Preserve省事有效。