学习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