ExcelVBA——数组（2）

上文将数组的基础介绍了一下，本篇将分享数组的一些实战案例。

image.png

求大于80分的平均分

Sub test()
Dim arr1(1 To 99)
arr = [b2:c9]
For Each a In arr
    If a >= 80 Then
        n = n + 1
        arr1(n) = a
    End If
Next
MsgBox WorksheetFunction.Average(arr1)
End Sub

VBA不强制区分大小写，也不强制声明变量，所以方式比较灵活，首先定义一个一维数组，将单元格区域分数区域赋值给arr数组，循环取出arr的值，然后判断是否大于80，如果大于80就将其写入另一个数组arr,最后对arr采用工作表函数average，average函数的特性为去除空值后的平均，最后用msgbox消息框输出平均分。

image.png

UBound与LBound函数

Ubound取出数组的最大下标（默认为第一维的下标，如果后面有参数则代表该维的下标）
Lbound取出数组的最小上标（默认为第一维的上标，如果后面有参数则代表该维的上标）

Sub test()
Dim arr(4 To 8, 1 To 3, 1 To 9)
MsgBox UBound(arr) '可简写为：UBound(arr）
MsgBox UBound(arr, 2)
MsgBox UBound(arr, 3)
MsgBox LBound(arr) 'LBound 用来确定数组某一维的上界。
End Sub

提取不重复值

• 提取不重复值用字典的方式比较方便，因为键值的键具有唯一性，而用数组的方式则要进行循环比对，最后取值。

  
  image.png

Sub 利用数组提取不重复值()
Dim arr1(1 To 10)
Set lastcell = Cells(Rows.Count, "b").End(xlUp) '查找最后B列最后一个非空单元格
arr = Range([b2], lastcell)     '将B列的姓名数据赋值给变量arr形成一个数组
For i = 1 To lastcell.Row - 1   '循环B列单元格个数的次数
    For j = 1 To UBound(arr1)   '找到arr1数组的最大小标，形成循环
        x = arr(i, 1): y = arr1(j) '辅助代码
        If arr(i, 1) = arr1(j) Then
            GoTo 100    'arr数组元素与arr1元素循环对比，如果相等，则跳出内层循环
        End If
    Next j
        k = k + 1   '做个计数器，计算相等重复的元素人数
        arr1(k) = arr(i, 1)  '如果循环完后都没有相等的，则将arr1循环的元素赋值给arr1数组
100:
Next i
[e2].Resize(k) = Application.Transpose(arr1)    '循环结束后将arr1的结果赋值给单元格区域
End Sub

分类求和

image.png

Sub 利用数组提取不重复值()
Dim arr1(1 To 10, 1 To 2)
Set endr = Cells(Rows.Count, "c").End(xlUp) '查找最后B列最后一个非空单元格
arr = Range([b2], endr) '将B列的姓名数据赋值给变量arr形成一个数组
For i = 1 To endr.Row - 1 '循环B列单元格个数的次数
    For j = 1 To UBound(arr1) '找到arr1数组的最大小标，形成循环
        x = arr(i, 1): y = arr1(j, 1) '辅助代码
        If arr(i, 1) = arr1(j, 1) Then
           arr1(j, 2) = arr(i, 2) + arr1(j, 2)
            GoTo 100 'arr数组元素与arr1元素循环对比，如果相等，则跳出内层循环
        End If
    Next j
        k = k + 1 '做个计数器，计算相等重复的元素人数
        arr1(k, 1) = arr(i, 1) '如果循环完后都没有相等的，则将arr1循环的元素赋值给arr1数组
        arr1(k, 2) = arr(i, 2)
100:
Next i
[e2].Resize(k, 2) = arr1 '循环结束后将arr1的结果赋值给单元格区域
End Sub

动态数组

ReDim 语句
在过程级别中使用，用于为动态数组变量重新分配存储空间。
ReDim [Preserve] varname( ) [As type]

可以使用 ReDim 语句反复地改变数组的元素以及维数的数目。 image.png

Sub test3()
Dim arr(), arr1()
rn = Cells(Rows.Count, 1).End(xlUp).Address
arr1 = Range("a2", rn)
m = WorksheetFunction.CountIf(Range("a2", rn), ">=80") '确定重新定义数组的上界
ReDim arr(1 To m)
For Each ar In arr1
    If ar >= 80 Then
        n = n + 1
        arr(n) = ar
    End If
Next
[c2].Resize(UBound(arr)) = Application.Transpose(arr)
End Sub