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