VBA(6)数组基本用法及写入输出

之之之之杰

已于 2022-06-12 21:15:29 修改

阅读量7.2k

点赞数 4

分类专栏： VBA 文章标签： microsoft

于 2022-06-12 21:13:52 首次发布

本文链接：https://blog.csdn.net/q14091355/article/details/125249966

版权

VBA 专栏收录该内容

19 篇文章 10 订阅

订阅专栏

1.数组的基本概念就不过多介绍了；本次为基础复习篇:直接上实例备注说明

Option Explicit			'强制声明变量要求		
Sub k1()         		  
    Dim t As Date
    Dim x#, m#
    t = Timer		'当前时间
    For x = 1 To 10000	'以内存形式运行
        m = m + 1000
    Next x
    MsgBox Timer - t
End Sub
Sub k2()
    Dim t As Date
    Dim x#, m#
    t = Timer
    For x = 1 To 10000	'调用单元格运行
        m = m + Cells(1, 1)
        Next x
        MsgBox Timer - t
End Sub

K例在本机测试K1运行时间为1帧不到，K2为16帧左右.故而注:调用内存时运行速度较快,在写宏时应尽量多使用内存/数组运算.

2.数组的写入及输出

Sub a1() 
    t = Timer
    Dim arr(1 To 10)
    Dim x#
    For x = 1 To 10
    arr(x) = x 		'循环数组方式写入数组
    Next
    Stop			'暂时方便查看立即窗口arr是否已写入数组
End Sub
Sub a2() 
    t = Timer
    Dim x#, y#
    Dim arr(1 To 10, 1 To 10)	'二维格式，已知最多可定义60维度，但常用是一维二维
    For x = 1 To 10		'循环将cells写入数组
        For y = 1 To 10
            arr(x, y) = Cells(x, y)
        Next y
    Next x
    Stop
End Sub
Sub a3()
    Dim arr()	 	   '声明动态数组,声明类型留空默认为Variant类型
    Dim y#, x#			
    y = Sheets(1).Range("a65536").End(xlUp).Row - 1		'表1最后一行-1
    ReDim arr(1 To y)			'重新声明ARR
        For x = 1 To y
            arr(x) = Cells(x, 1)
        Next
    Stop
End Sub
Sub a4() 
    Dim arr2()
        arr2 = Array(1, 2, 3, 4, "arr5")	'用函数批量写入
    Stop
End Sub
Sub a5() 
    Dim arr()	
        arr = Range("a1:a5")		'单元格写入
    Stop				'此处暂停查看可得知用单元格写入动态数组默认为一个二维的数组,例a5的arr(1 to 5,1)
    Range("b1:b5") = arr()
End Sub
Sub a6() 
    Dim arr(), arr1(1 To 5, 1 To 1)
    Dim x As Integer
    arr = Range("b2:c6")		
    For x = 1 To ubound(arr,1)			'ubound(数组,2)指定维度的最大上标
        arr1(x, 1) = arr(x, 1) * arr(x, 2)		'ubound(数组)数组上标
    Next					'lbound(数组)数组下标
    Range("d2").Resize(ubound(arr1,1)) = arr1	'读取数组到单元格
End Sub
Sub a7()
    Dim arr, arr1(1 To 5)
    Dim x As Integer
    arr = Range("b2:c6")
    For x = 1 To 5
        arr1(x) = arr(x, 1) * arr(x, 2)
    Next					    '一维数组放入列需转置
    Range("d2").Resize(5) = Application.Transpose(arr1)
End Sub
Sub a8()
    Dim arr, arr1(1 To 1000, 1 To 1)		
    Dim x As Integer
    arr = Range("b2:c6")
    For x = 1 To 5
        arr1(x, 1) = arr(x, 1) * arr(x, 2)		    '数组部分存入
    Next
    Range("d2").Resize(4) = arr1		 '不管数组有多大，单元格赋值只能按单元格区域大小部分
End Sub

'以上几种为数组常见赋值方式,部分版本定义一个变量体可也以将单元格装入(a8例:dim arr)
'Option base 默认下标不改变的情况下:数组声明如果为arr(5)则arr(0 - 5)有6个元素.

3.数组常用函数

Sub s1()
    Dim arr(), arr1()
   'Dim arr(), arr1(1 To 100, 1 To 4)   '可以定义一个足够大的数组，利用区域大小限置输入
    Dim x#, k#
    arr = Range("a1:c3")
    For x = 1 To UBound(arr)                        'ubound(arr) 如果有多维默认= ubound(arr,1)
        If arr(x, 1) = 1 Then                       '如果arr(x,1)第一列的值符合则
        k = k + 1                                   'k为记录行数,
        ReDim Preserve arr1(1 To 3, 1 To k)         'dim preserve arr1()重新声明数组大小;保留原有数值
        arr1(1, k) = arr(x, 1)
        arr1(2, k) = arr(x, 2)
        arr1(3, k) = arr(x, 3)
    End If
    Next
    'Stop
        'ReDim Preserve arr1(1 To 3, 1 To 1)        '测试如减少维度则相对应减少。其他保留值
    Range("e10").Resize(k, 4) = Application.Transpose(arr1)     'Resize扩展多少行多少列，如数组不够单元格区域大则返回错误值#N/A
End Sub
Sub s2()
    Dim arr, arr1(1 To 1000, 1 To 1)    '定义一个足够大的数组
    Dim x#, m#, k#                      '定义三个数值型变量
    arr = Range("a1:a10")               '数据源为{1;2;3;;5;6;;8;9;}
    For x = 1 To UBound(arr)            '上标为10
        If arr(x, 1) <> "" Then         '如果不为空则计数
        k = k + 1
        arr1(k, 1) = arr(x, 1)          '装入新数组
        Else                            '如果为空的则计数
        m = m + 1
        Range("e1").Offset(0, m).Resize(k) = arr1   '将之前连续不为空的数组输出到单元格
        Erase arr1                      '清空数组，使用ERASE语句
        k = 0                           '重置计数
    End If
    Next x
End Sub
'表格内加入一个ActiveX控件:组合框
Private Sub ComboBox1_Change() 	'利用数组将条件要求的数存入控件
    Dim arr(), arr1
    Dim x#, k#
    arr1 = Range("a1:a10")		'装入数组1
        For x = 1 To UBound(arr1)	'数组1循环
            If arr1(x, 1) > 8 Then		'条件设置
            k = k + 1			'计数
            ReDim Preserve arr(1 To k)	'保留原有值重新声明
            arr(k) = arr1(x, 1)		'满足条件的值装入新数组
        End If
    Next x
    ComboBox1.List = arr		'新数组赋值给控件
End Sub
Sub s4()
    Dim sr$, arr
    sr = "A-1-BB-2CD-EFG"
    arr = VBA.Split(sr, "-") 	'split(拆分，分隔符)
    MsgBox Join(arr, "-")  	 'join(合并, 连接符)/join ( arr )第二参数省略情况下默认为空格连接
End Sub
Sub s5()
    Dim arr, arr1, arr2, arr3
    arr = Application.Transpose(Range("a2:a10"))
    arr1 = VBA.Filter(arr, 333, True)                  '数组里面包含333的      filter(数组,关键字,TRUE=包含/FALSE反之)
    arr2 = VBA.Filter(arr, "B", False)                  '数组里面不包含B的
    Range("b2").Resize(UBound(arr1) + 1) = Application.Transpose(arr1)          'filter返回数组为0至上标,故+1=元素个数
    Range("c2").Resize(UBound(arr2) + 1) = Application.Transpose(arr2)          '一维数组输出单元格用Transpose转置
    'Stop                                               '调试时可用暂停查看
End Sub
Sub s6()
    Dim arr, arr1, arr2
    arr = Range("a2:d6")
    arr1 = Application.Index(arr, 0, 1)		'index(二维,0,列数)返回一个二维数
    arr2 = Application.Index(arr, 2, 0)		'index(二维,行数,0)返回一个一维数
    Stop
End Sub
Sub s7()
    Dim arr, arr1, arr2
    arr = Range("a1:B11")
    arr1 = Application.VLookup(Array("B", "A"), arr, 2, 0)      '利用单元格函数返回array("B","A")第一个查找的值的数值arr(1 to 2)
    arr2 = Application.SumIf(Range("a2:a10"), Array("A", "B"), Range("b2:b10"))     '利用sumif返回一个数组
    Stop
End Sub
Sub s8()
    Dim arr, arr1(1 To 3, 1 To 2), x#
    arr1(1, 1) = "A"
    arr1(2, 1) = "B"
    arr1(3, 1) = "C"
    For x = 1 To 100                '循环100行
        Select Case Cells(x, 1)
            Case "A"                '如果为A则累加。下面同理
            arr1(1, 2) = Cells(x, 2) + arr1(1, 2)
            Case "B"
            arr1(2, 2) = Cells(x, 2) + arr1(2, 2)
            Case "C"
            arr1(3, 2) = Cells(x, 2) + arr1(3, 2)
        End Select
    Next
    Stop         '暂停查看得到一个arr1{A,B,C;累加，累加，累加}同sumifs效果的数组
End Sub

'调用工作表函数的情况下运行速度不如VBA函数,常见处理函数ARRAY,SPLIT,JOIN,FILTER,INDEX。