面向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