面向VBA一維數組的實用自定義函數

 UDF.dll包含了一組實用的用戶自定義函數，提供了數組處理的快速方法，能夠在VB六、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