|
常常在论坛看到很多VBA高手运用数组解决各种问题，速度快，代码简洁，很是羡慕，所以逐渐收集了一些资料，与大家分享，也请多多指教。在此，也向高手们致以谢意。
一、数组的分类
按元素数目分：元素数目大小固定的数组和元素数目大小不固定的动态数组。
按维数分：一维数组、多维数组。
Arr(1 to 12)、Arr1(0 to 24)----一维固定数组；
Arr2(1 to 5,1 to 8)---- 二维固定数组；
Arr3(5 to 10,6 to 12,1 to 100) ---- 三维固定数组。
动态数组
Dim Arr2(),r%
r=r+1
ReDim Preserve Arr2(1 To r) ―――动态数组；可以重新声明（只有最后一维的数目才能重新声明）；用了关键字 Preserve 可确保原来包含数据的数组中的任何数据都不会丢失。
二、数组的赋值
2.1，单元格区域保存到数组
arr = [e22:i24]
arr=Range(“e22:i24”)
2.2，Array函数
myArray = Array("AAA", "BBB", 200, 500, "2006-7-12")
如果代码头没有 Option Base 1 的语句，则数组myArray的上限为4，下限为0。
即下限LBound(myArr)=0 ，上限 UBound(myArr)=4
二维数组的第一维的上限：UBound(Arr,1)
二维数组的第二维的上限：UBound(Arr,2)
多维数组上限的求法一样。
2.3，把单元格区域公式赋给数组
如果a5=B4+1
arr = [a4:c8].Formula '将单元格绝对引用公式保存到数组
[e4:g8]=arr 此时e5中的公式也＝B4+1;
如果将单元格相对引用公式保存到数组
arr = [a4:c8].FormulaR1C1
如果a5=B4+1
[e4:g8]=arr 此时e5中的公式就＝E4+1;
三、数组的处理
3.1，数组里的最大值和最小值
最大值aa = Application.WorksheetFunction.Max(Arr)
aa= Application.WorksheetFunction.Large(Arr,1)
最小值aa = Application.WorksheetFunction.Min(Arr)
aa= Application.WorksheetFunction.Small(Arr,1)
3.2，数组里搜索
Temp = Filter(Arr, xm(i)) '搜索数组 如果筛选结果为空值，UBound( Temp) = -1
| |
Sub yy()
Dim Arr(), aa$, x%
aa = "asssfffssssaaasss": bb = "s"
For x = 1 To Len(aa)
ReDim Preserve Arr(1 To x)
Arr(x) = Mid(aa, x, 1)
Next x
temp = Filter(Arr, bb)
cc = UBound(temp) + 1 'cc= “s”的个数
End Sub |
用于对字符串数组进行搜索，得到一个新的数组temp，
缺点：只告诉你某元素是否存在于数组中，而不知道其具体位置；
数组精确搜索：
| |
Sub FilterExactMatch()
' 该函数在一个字符串数组中搜索那些
' 与搜索字符串完全匹配的元素。
Dim astrFilter() As String
Dim astrTemp() As String
Dim lngUpper As Long
Dim lngLower As Long
Dim lngIndex As Long
Dim lngCount As Long
astrItems = Array("a", "sas", "s", "Sas", "s", "f", "f", "f", "f", "sas", "s", "sas", "a", "a", "Sas", "s", "s")
strSearch = "Sas"
' 为搜索字符串而过滤数组。
astrFilter = Filter(astrItems, strSearch)
' 存储结果数组的上限和下限。
lngUpper = UBound(astrFilter)
lngLower = LBound(astrFilter)
' 将临时数组调整到相同大小。
ReDim astrTemp(lngLower To lngUpper)
' 在经过滤的数组的每个元素中循环。
For lngIndex = lngLower To lngUpper
' 检查该元素是否与搜索字符串完全匹配。
If astrFilter(lngIndex) = strSearch Then
' 在另一个数组中存储完全匹配的元素。
astrTemp(lngCount) = strSearch
lngCount = lngCount + 1
End If
Next lngIndex
' 重新调整包含完全匹配的元素的数组的大小。
ReDim Preserve astrTemp(lngLower To lngCount - 1)
' 返回包含完全匹配的元素的数组。
'[a5].Resize(1, UBound(astrTemp) + 1) = Application.Transpose(astrTemp)
[a5].Resize(1, UBound(astrTemp) + 1) =astrTemp
End Sub |
3.3，转置
取工作表区域的转置到数组：arr=Application.Transpose([a1:c5]) '此时arr是转置成3行5列的数组，arr(1 to 3,1 to 5)
[e1:i3]=arr '此时3行5列。
数组间也可以转置：arr1=Application.Transpose(arr)
取数组arr的第n列赋值到某列区域：[e1:e5]=Application.Index(arr, 0, n)
也可写成 [e1:e5]=Application.Index(arr, , n)
赋值产生一个新数组：arr1=Application.Index(arr,0 , n)
取数组arr的第n行赋值到某行区域：[a6:c6]=Application.Index(arr,n ,0 )
也可写成 [a6:c6]=Application.Index(arr,n ) 省略0，也省略了“,”
赋值产生一个新数组：arr1=Application.Index(arr, n )
3.4，数组的比较（字典法）
题目：将A列中的数据与C列相比较,输出C列中没有的数据到D列：
| |
Sub cc()
'by:ccwan
Dim arr, brr, i&, x&, d As Object
arr = Range("a1:a" & [a65536].End(xlUp).Row)
brr = Range("c1:c" & [c65536].End(xlUp).Row)
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
d(arr(i, 1)) = ""
Next
For x = 1 To UBound(brr)
If d.exists(brr(x, 1)) Then
d.Remove brr(x, 1)
End If
Next
[d1].Resize(d.Count, 1) = Application.Transpose(d.keys)
End Sub |
3.5，数组的排序
字符串数组不能用Large(Arr,i) 或者 Small(Arr,i) 来排序；
但数值数组可以；
一个很好的字典+数组排序的实例：
| |
Sub yy1()
'by:oobird
Dim i%, c As Range, x, d As Object
Set d = CreateObject("Scripting.Dictionary")
For Each c In Sheet2.UsedRange
If c.Value <> "" Then
If Not d.exists(c.Value) Then
d.Add c.Value, 1
Else
d(c.Value) = d(c.Value) + 1
End If
End If
Next
k = d.keys: t = d.items 'k是各个不重复值，t是各个不重复值的个数
ReDim x(1 To 2, 1 To d.Count)
For i = 1 To d.Count
x(2, i) = Application.Large(k, i) '从大到小排序
x(1, i) = d(x(2, i))
Next i
With Sheet1
.[b2].Resize(2, i - 1) = x
ReDim x(1 To 2, 1 To d.Count)
For i = 1 To d.Count
x(1, i) = Application.Max(t) '从大到小排序
w = Application.Match(x(1, i), t, 0) - 1 '查找此值在不重复值系列中的排位，因为w是从0开始的，所以－1
x(2, i) = k(w) '求得对应的不重复值
t(w) = "" '使前面的最大值为空，继续循环
Next i
.[b5].Resize(2, i - 1) = x '两行一起赋值给B5开始的单元格
End With
End Sub |
字符串数组的排序，可以使用辅助列，把数组各元素依次赋给单元格，然后对这些单元格运用Excel自有的数据排序功能进行排序，再把单元格排过序的值重新赋给数组。
3.6，数组赋给单元格区域
r=Ubound(Arr) r为一维数组的上限;
Range("a2").Resize(1, r) = Arr '填充到工作表的一行之中（Arr为一维数组）
或者写成 Range("a2").Resize(1, Ubound(Arr)) = Arr
二维数组Arr(100,5)
Range("a1").Resize(100,5)=Arr
[a1:e100]=Arr
或者写成 Range("a1").Resize(Ubound(Arr,1), Ubound(Arr,2)) = Arr
赋值方面的补充：
| |
Sub y()
Dim arr
arr = [mmult(row(1:100),column(a:f))]
[a1].Resize(100, 6) = arr
End Sub
Sub yy()
Dim arr
arr = [column(a:z)^3]
MsgBox Join(arr, ",")
arr = [transpose(row(1:222))]
MsgBox Join(arr, ",")
End Sub
Sub yyy()
Dim arr
arr = Split("a b c d e f g")
MsgBox Join(arr, ",")
End Sub |
|
