Excel VBA解读（157）： 数据结构—ArrayList（续）

学习Excel技术，关注微信公众号：

excelperfect

上篇文章，我们初步认识了ArrayList，下面进一步了解其排序、复制、数组转换等功能。

排序

Sort方法对ArrayList按升序排列：

Sub testSort()

Dim alCol As Object

Set alCol = CreateObject("System.Collections.ArrayList")

alCol.Add "3"

alCol.Add "1"

alCol.Add "5"

alCol.Add "4"

alCol.Add "2"

'排序

alCol.Sort

Debug.Print "升序排列"

DebugPrint alCol

End Sub

Sub DebugPrint(alColl As Object)

Dim i As Long

For i = 0 To alColl.Count - 1

Debug.Print alColl(i)

Next i

End Sub

运行结果如下图6所示。

图6

在Sort方法之后，再使用Reverse方法，将按照降序排列：

Sub testSort()

Dim alCol As Object

Set alCol = CreateObject("System.Collections.ArrayList")

alCol.Add "3"

alCol.Add "1"

alCol.Add "5"

alCol.Add "4"

alCol.Add "2"

'排序

alCol.Sort

alCol.Reverse

Debug.Print "降序排列"

DebugPrint alCol

End Sub

Sub DebugPrint(alColl As Object)

Dim i As Long

For i = 0 To alColl.Count - 1

Debug.Print alColl(i)

Next i

End Sub

运行结果如下图7所示。

图7

“克隆”ArrayList

使用Clone方法可以创建ArrayList的全新副本：

Sub testClone()

Dim alColl1 As Object

Set alColl1 = CreateObject("System.Collections.ArrayList")

'添加元素

alColl1.Add "完美Excel"

alColl1.Add "excelperfect"

alColl1.Add "Excel"

'创建副本

Dim alColl2 As Object

Set alColl2 = alColl1.Clone

'删除

alColl1.Clear

Debug.Print "alColl1包含元素:"

DebugPrint alColl1

Debug.Print "alColl2包含元素:"

DebugPrint alColl2

End Sub

Sub DebugPrint(alColl As Object)

Dim i As Long

For i = 0 To alColl.Count - 1

Debug.Print alColl(i)

Next i

End Sub

运行结果如下图8所示。

图8

可以看出，使用Clone方法将alColl1赋给alColl2后，清空alColl1中的元素，对alColl2没有影响。

注意，如果使用语句：

set alColl2 = alColl1

将指向同一个ArrayList。

注意，代码中使用Clear方法删除ArrayList中的所有元素项。

复制ArrayList到数组

ToArray方法可以将ArrayList复制到数组：

Sub testClone()

Dim alColl As Object

Set alColl = CreateObject("System.Collections.ArrayList")

'添加元素

alColl.Add "完美Excel"

alColl.Add "excelperfect"

alColl.Add "Excel"

'复制

Dim arr As Variant

arr = alColl.ToArray

'打印

Debug.Print "打印数组元素:"

DebugPrintArray arr

End Sub

Sub DebugPrintArray(arr As Variant)

Dim i As Long

For i = LBound(arr) To UBound(arr)

Debug.Print arr(i)

Next i

End Sub

运行结果如下图9所示。

图9

将ArrayList复制到二维数组

可以创建一个自定义函数，将ArrayList复制到二维数组。这样，就可以直接将值写入到工作表单元格区域中。

Sub testCopy2D()

Dim alColl As Object

Set alColl = CreateObject("System.Collections.ArrayList")

'添加元素

alColl.Add "完美Excel"

alColl.Add "excelperfect"

alColl.Add "Excel"

'复制

Dim arr As Variant

arr = CopyToArray(alColl)

'写入工作表

Worksheets("Sheet1").Range("A1:A3") = arr

End Sub

Function CopyToArray(alColl As Object) As Variant

Dim arr As Variant

ReDim arr(1 To alColl.Count, 1 To 1)

Dim i As Long

For i = 0 To alColl.Count - 1

arr(i + 1, 1) = alColl(i)

Next i

CopyToArray = arr

End Function

运行代码后，将在工作表Sheet1中输入ArrayList的内容。

将一维数组元素复制到ArrayList

可以编写自定义函数，将一维数组元素复制到ArrayList：

Sub GetItemFromArray1D()

Dim arr(1 To 3) As Variant

arr(1) = "完美Excel"

arr(2) = "excelperfect"

arr(3) = "Excel"

Dim alColl As Object

Set alColl = Array1DToArrayList(arr)

DebugPrint alColl

End Sub

Function Array1DToArrayList(arr As Variant) As Object

'检查是否是一维数组

On Error Resume Next

Dim n As Long

n = -1

n = UBound(arr, 2)

On Error GoTo 0

If n <> -1 Then

Err.Raise vbObjectError + 513,"Array1DToArrayList", _

"数组只能是一维数组"

End If

'创建ArrayList

Dim alColl As Object

Set alColl = CreateObject("System.Collections.ArrayList")

'添加元素

Dim i As Long

For i = LBound(arr, 1) To UBound(arr, 1)

alColl.Add arr(i)

Next i

'返回值

Set Array1DToArrayList = alColl

End Function

Sub DebugPrint(alColl As Object)

Dim i As Long

For i = 0 To alColl.Count - 1

Debug.Print alColl(i)

Next i

End Sub

运行结果如下图10所示。

图10

将二维数组元素复制到ArrayList

可以编写自定义函数，将二维数组元素复制到ArrayList：

Sub GetItemFromArray2D()

Dim alColl As Object

Set alColl =Array2DToArrayList(Worksheets("Sheet1").Range("A1:A3").Value)

DebugPrint alColl

End Sub

Function Array2DToArrayList(arr As Variant) As Object

'检查是否是二维数组

If UBound(arr, 2) > 1 Then

Err.Raise vbObjectError + 513,"Array2DToArrayList", _

"单元格区域/数组只能是一列"

End If

'创建ArrayList

Dim alColl As Object

Set alColl =CreateObject("System.Collections.ArrayList")

'添加元素

Dim i As Long

For i = LBound(arr, 1) To UBound(arr, 1)

alColl.Add arr(i, 1)

Next i

'返回值

Set Array2DToArrayList = alColl

End Function

Sub DebugPrint(alColl As Object)

Dim i As Long

For i = 0 To alColl.Count - 1

Debug.Print alColl(i)

Next i

End Sub

运行结果如下图11所示。

图11