面向VBA一维数组的实用自定义函数

 UDF.dll包含了一组实用的用户自定义函数,提供了数组处理的快速方法,可以在VB6、VBS、32位VBA中调用。

看完如下的实例代码,就明白它的用处了。

Private MyUDF As New UDF.ArrayConversion
Sub 是否包含某元素()
    Dim Array1(2 To 5) As String
    Array1(2) = "Word"
    Array1(3) = "Excel"
    Array1(4) = "Outlook"
    Array1(5) = "Access"
    Debug.Print MyUDF.Contains(Array1, "Excel") '打印结果为True
End Sub
Sub 倒序()
    Dim Array1(2 To 5) As String
    Array1(2) = "Word"
    Array1(3) = "Excel"
    Array1(4) = "Outlook"
    Array1(5) = "Access"
    Dim Array2 As Variant
    Array2 = MyUDF.Reverse(Array1) '倒序的结果返回给Array2
    Debug.Print Join(Array2, "/") '打印结果为Access/Outlook/Excel/Word
    MyUDF.ReverseSelf Array1 '直接对Array1进行倒序
    Debug.Print Join(Array1, "/") '打印结果为Access/Outlook/Excel/Word
End Sub
Sub 去重()
    Dim Array1(2 To 6) As Integer
    Array1(2) = 22
    Array1(3) = 33
    Array1(4) = 22
    Array1(5) = 44
    Array1(6) = 33
    Dim Array2 As Variant
    Array2 = MyUDF.Distinct(Array1)
    Debug.Print Join(Array2, "/") '打印结果为22/33/44
End Sub
Sub 连接数组()
    Dim Array1(2 To 5) As String
    Array1(2) = "Word"
    Array1(3) = "Excel"
    Array1(4) = "Outlook"
    Array1(5) = "Access"
    Dim Array2 As Variant
    Array2 = MyUDF.JoinArray(Array1, Array(1, 2, 3), Array(True, False))
    Debug.Print Join(Array2, "/") '打印结果为Word/Excel/Outlook/Access/1/2/3/True/False
End Sub
Sub 排序()
    Dim Array1(2 To 5) As String
    Array1(2) = "Word"
    Array1(3) = "Excel"
    Array1(4) = "Outlook"
    Array1(5) = "Access"
    Dim Array2 As Variant
    Array2 = MyUDF.Sort(Array1)
    Debug.Print Join(Array2, "/") '打印结果为Access/Excel/Outlook/Word
    MyUDF.SortSelf Array1 '对Array1自身升序
    MyUDF.ReverseSelf Array1 '对Array1自身倒序
    Debug.Print Join(Array1, "/") '打印结果为Word/Outlook/Excel/Access
End Sub
Sub 检索元素位置()
    Dim Array1(2 To 6) As String
    Array1(2) = "Word"
    Array1(3) = "Excel"
    Array1(4) = "Outlook"
    Array1(5) = "Access"
    Array1(6) = "Excel"
    Debug.Print MyUDF.IndexOf(Array1, "Outlook") '结果:4
    Debug.Print MyUDF.IndexOf(Array1, "outlook") '结果:-1
    Debug.Print MyUDF.LastIndexOf(Array1, "Excel") '结果:6
End Sub
Sub 指定位置插入另一数组()
    Dim A(2 To 6) As Integer
    A(2) = 22
    A(3) = 33
    A(4) = 22
    A(5) = 44
    A(6) = 33
    Dim B(-3 To -1) As String
    B(-3) = "Word"
    B(-2) = "Excel"
    B(-1) = "Outlook"
    Dim Array3 As Variant
    Array3 = MyUDF.InsertRange(A, 4, B)
    Debug.Print Join(Array3, "/") '打印结果为22/33/Word/Excel/Outlook/22/44/33
End Sub
Sub 删除连续多个元素()
    Dim Array1(2 To 6) As String
    Array1(2) = "Word"
    Array1(3) = "Excel"
    Array1(4) = "Outlook"
    Array1(5) = "Access"
    Array1(6) = "Excel"
    Dim Array2 As Variant
    Array2 = MyUDF.RemoveRange(Array1, 3, 2)
    Debug.Print Join(Array2, "/") '打印结果为Word/Access/Excel
End Sub
Sub 部分元素构成新数组()
    Dim Array1(2 To 6) As String
    Array1(2) = "Word"
    Array1(3) = "Excel"
    Array1(4) = "Outlook"
    Array1(5) = "Access"
    Array1(6) = "Excel"
    Dim Array2 As Variant
    Array2 = MyUDF.GetRange(Array1, 3, 3)
    Debug.Print Join(Array2, "/") '打印结果为Excel/Outlook/Access
End Sub
Sub 用另一数组覆盖一部分元素()
    Dim Array1(2 To 6) As Integer
    Array1(2) = 2
    Array1(3) = 3
    Array1(4) = 4
    Array1(5) = 5
    Array1(6) = 6
    Dim Array2(2) As String
    Array2(0) = "Word"
    Array2(1) = "Excel"
    Array2(2) = "Outlook"
    Dim Array3 As Variant
    Array3 = MyUDF.SetRange(Array1, 3, Array2)
    Debug.Print Join(Array3, "/") '打印结果为2/Word/Excel/Outlook/6
End Sub

 

 下载地址:UDF.zip

下载后解压缩,根据 使用说明.txt 中的内容执行操作。

注册成功后,可以在VBA添加如下引用:

 

 

2019/6/28 新增一个求和函数,可以对任意形式的数组进行数值求和,即使嵌套的数组也可以逐层求出。用法如下:

除了下面列出的实例外,大家如果有其他类型的求和,也可以用该函数试试。

Sub 对多个参数直接求和()
    '参数个数不限
    Total = MyUDF.Sum(1, 2, 3, "Test", 4)
    Debug.Print Total '返回10
End Sub
Sub 对任意数组求和()
    Dim AnyArray As Variant
    AnyArray = Array(-1, -2, Array(3, 4, 5), 6)
    Debug.Print MyUDF.Sum(AnyArray) '返回15
End Sub
Sub 对多个数组求和()
    Dim A(1 To 2) As Integer
    Dim B(1 To 3) As Single
    A(1) = 1: A(2) = 2
    B(1) = 1: B(2) = 2: B(3) = 3
    Debug.Print MyUDF.Sum(A, B) '返回9
End Sub

转载于:https://www.cnblogs.com/ryueifu-VBA/p/11099415.html

  • 0
    点赞
  • 0
    评论
  • 4
    收藏
  • 扫一扫,分享海报

表情包
插入表情
评论将由博主筛选后显示,对所有人可见 | 还能输入1000个字符
©️2022 CSDN 皮肤主题:编程工作室 设计师:CSDN官方博客 返回首页
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、C币套餐、付费专栏及课程。

余额充值