http://www.51zxw.net/study.asp?vip=10241777 資料學(xué)習(xí)的網(wǎng)址
''數(shù)組
''數(shù)組就是一個列或一組數(shù)據(jù)表
'數(shù)組存儲在內(nèi)存中 A.讀寫速度快 B.永遠無法保存
''數(shù)組的分類 一般分為:1維 ,2維,3維 ....60維
Sub shuzuText()
Dim arr1(3) '4個 從0開始
Dim arr2(1 To 3) '3個 從1開始
Dim arr3(1 To 3, 1 To 2) '6個 3行2列
Dim arr4(3, 2) '12個 0-3 ，0-2 4行3列
End Sub
Sub text1()
Dim arr1(0 To 3)
arr2 = [{"A","B","C","D"}]
arr3 = Application.Transpose([{1;2;3;4}])
arr4 = [{"張","1";"王","2";"陳","3"}] ''' 用 ,號是隔列 用 ; 隔行
''array 公式
arr5 = Array(1, 2, 3, 4)
arr6 = Array(Array("a", "b"), Array(1, 2, 3))
End Sub
Sub 向數(shù)組中直接寫入數(shù)據(jù)()
Dim arr(1 To 10)
arr(1) = "我"
arr(2) = "是"
arr(3) = "誰"
''數(shù)組循環(huán)寫入()
Dim arr1(1 To 4)
Dim rng As Range
For Each rng In Range("a1:a3")
n = n + 1
arr1(n) = rng
Next
''寫入一般數(shù)組
Dim arry() ''動態(tài)的
arry = Array("A", "B", "C")
End Sub
Sub 單元格區(qū)域數(shù)據(jù)批量寫入數(shù)組()
''一行一列可轉(zhuǎn)為一維數(shù)組 向數(shù)組中寫入多行 是二維數(shù)組
arr = [a1:a3] ''豎向 二維數(shù)組 1,1 2,1 3,1
arr = Application.Transpose([a1:a3]) ''Transpose 轉(zhuǎn)置為 一維數(shù)組
arr1 = [A1:C3] ''橫向 1,1 1,2 1,3
arr1 = Application.Transpose([A1:C3]) ''先轉(zhuǎn)為豎向
arr1 = Application.Transpose(Application.Transpose([A1:C3])) ''先轉(zhuǎn)為豎向 再轉(zhuǎn)為1維素數(shù)組
End Sub
Sub 取數(shù)組中指定的元素()
arr = [a1:a3]
a = arr(1, 1)
b = arr(2, 1)
End Sub
Sub 數(shù)組循環(huán)取值()
arr = [a1:A10] ''二維數(shù)組
[b1] = arr(2, 1)
For i = 1 To 8
Cells(i, 3) = arr(i, 1)
Next
End Sub
Sub 數(shù)組一次性賦值()
arr = [a1:a8]
Range("d1:d8") = arr
Range("d1:d" & 8) = arr
End Sub
Sub 用transpose函數(shù)轉(zhuǎn)置()
arr = [a1:E1]
arr1 = Application.Transpose(arr) ''--橫 變 豎
[a7:d7] = arr1 ''錯誤 :::已經(jīng)變成豎列 只顯示第一列內(nèi)容
[F1:F7] = arr1 ''正常
''要注意兩邊的尺寸
End Sub
Sub 數(shù)組計算()
'在數(shù)組中求和 平均
arr = [a1:b5]
a = WorksheetFunction.Sum(arr) ''合
a = WorksheetFunction.Average(arr) ''平均
a = WorksheetFunction.Max(arr) ''最大
a = WorksheetFunction.Min(arr) ''最下
a = WorksheetFunction.Small(arr, 2) ''第2個最小的
a = WorksheetFunction.Large(arr, 2) ''第2個最大的
End Sub
Sub 數(shù)組實例()
Dim arr1(1 To 20) ''用于存儲 數(shù)據(jù)
arr = [b2:c9]
For Each a In arr
If a > 80 Then
n = n + 1
arr1(n) = a ''存入數(shù)組
End If
Next
S = WorksheetFunction.Average(arr1)
End Sub
Sub 數(shù)組效率測試一般方法()
t = Timer
Set rng = Cells(Rows.Count, 1).End(xlUp) ''最后個單元格
arr = Range([a1], rng)
For Each a In arr
If a > 80 Then
n = n + 1
Cells(n, 3) = a
End If
Next
MsgBox Format(Timer - t, "0.0000") ''返回反應(yīng)時間
End Sub
Sub 數(shù)組效率測試數(shù)組方法()
'Dim arr1(1 To 999)
Dim arr1(1 To 999, 1 To 1)
t = Timer
Set rng = Cells(Rows.Count, 1).End(xlUp)
arr = Range([a1], rng) ''數(shù)組寫入
For Each a In arr
If a > 80 Then
n = n + 1
' arr1(n) = a ''將滿足條件的賦值
arr1(n, 1) = a
End If
Next
'[d3].Resize(n) = Application.Transpose(arr1) ''轉(zhuǎn)置
[d1].Resize(n, 1) = arr1
End Sub
Sub ULBound() '上界UBound 下界 LBound
Dim arr(4 To 8, 1 To 3, 1 To 9)
MsgBox UBound(arr, 1) ''第一維 的 上界
MsgBox LBound(arr, 1) ''第一維 的 下界
MsgBox UBound(arr, 2) ''第二維 的 上界
End Sub
Sub 利用數(shù)組提取不重復(fù)的值()
Dim arr1(1 To 10)
Set lastcell = Cells(Rows.Count, 1).End(xlUp)
arr = Range("a1", lastcell) ''將A列姓名存入數(shù)組
For i = 1 To lastcell.Row ''循環(huán)A列單元格 ''ubound(arr)
For j = 1 To UBound(arr1) ''用于記錄 循環(huán)跟這個數(shù)組對比
X = arr(i, 1): y = arr1(j) ''輔助代碼
If arr(i, 1) = arr1(j) Then
GoTo 100 ''有相等跳到下個循環(huán)
End If
Next
''
k = k + 1 ''用于累計
arr1(k) = arr(i, 1)
100:
Next
[e2].Resize(k) = Application.Transpose(arr1)
End Sub
Sub 利用數(shù)組提取不重復(fù)的值并計算()
Dim arr1(1 To 10, 1 To 2)
Set endr = Cells(Rows.Count, 1).End(xlUp)
arr = Range("b1", endr)
For i = 1 To endr.Row ''循環(huán)A列單元格
For j = 1 To UBound(arr1) ''空的 用于記錄 找到arr1 數(shù)組的最大值,形成循環(huán)
X = arr(i, 1): y = arr1(j, 1) ''輔助代碼
If arr(i, 1) = arr1(j, 1) Then ''循環(huán)判斷單元格 是否等于 arr1
arr1(j, 2) = arr(i, 2) + arr1(j, 2) ''如果A列單元格 等于 arr1(j, 1) 將B列單元格的值 賦值給 arr1(j,1) 疊加
GoTo 100
End If
Next
k = k + 1 ''如果沒有相等
arr1(k, 1) = arr(i, 1) ''把姓名,值 寫入 arr1 數(shù)組
arr1(k, 2) = arr(i, 2)
100:
Next
[e2].Resize(k, 2) = arr1
End Sub
''有 Redim 重新申明 ,之后可以重新申明數(shù)組的上界,而不是一個估計的值
Sub Redim條件篩選實列()
Dim arr(), arr1()
rn = Cells(Rows.Count, 1).End(xlUp).Address
arr1 = Range("a1", rn) ''把區(qū)域單元格寫入數(shù)組
m = WorksheetFunction.CountIf(Range("a2", rn), ">=80") ''統(tǒng)計區(qū)域內(nèi)>=80的個數(shù)
ReDim arr(1 To m) ''重新確定數(shù)組上限
For Each ar In arr1
If ar >= 80 Then
n = n + 1
arr(n) = ar
End If
Next
[e1].Resize(UBound(arr)) = Application.Transpose(arr)
End Sub
Sub 數(shù)組重新定義保存()
Dim arr()
i = 9
arr = [{1,2,3}]
ReDim Preserve arr(1 To 5) ''重新定義數(shù)組 并保存之前的數(shù)組
ReDim Preserve arr(1 To 9)
ReDim arr(1 To 9)
End Sub
Sub 動態(tài)數(shù)組多表合并() ''利用數(shù)組匯總
Dim rng As Range
Dim arr()
For Each Sh In Sheets ''對工作簿進行循環(huán)
If Sh.Name <> "統(tǒng)計" Or Sh.Name <> "加密機密文件" Then
''Sh.UsedRange.Rows.Count 統(tǒng)計工作簿已使用的區(qū)域
arr1 = Sh.Range("A1:B" & Sh.UsedRange.Rows.Count) ''將工作簿數(shù)據(jù)區(qū)域賦值
act = act + UBound(arr1) ''累加各表的行 ,將作為重新聲明arr1
ReDim Preserve arr(1 To 2, 1 To act) ''重新聲明 arr 2行 X列
For j = 1 To UBound(arr1)
n = n + 1 ''匯總表累計
arr(1, n) = arr1(j, 1) ''arr1對應(yīng)寫入arr中
arr(2, n) = arr1(j, 2)
Next
End If
Next
Sheets("統(tǒng)計").Range("a1").Resize(n, 2) = Application.Transpose(arr)
End Sub
''
'' Split 函數(shù)(作用于1維數(shù)組)
'返回一個下標從零開始的一堆數(shù)組
Sub Splittext()
Dim i$
i = "a-b-c-d-e-f"
arr = Split(i, "-") '以橫線為 拆分成一維數(shù)組
[a22].Resize(1, UBound(arr)) = arr
End Sub
Sub 數(shù)據(jù)互換()
[a1].CurrentRegion.Select
arr = [a1].CurrentRegion ''數(shù)組賦值
For Each a In arr ''對數(shù)組進行循環(huán)
arr1 = Split(a, "-")
n = n + 1
Cells(n, 3) = arr1(1) & "-" & arr1(0)
Next
End Sub
''join 函數(shù)作用于1維數(shù)組 返回字符串
Sub join數(shù)據(jù)合并()
i = Sheet4.Cells(Rows.Count, 1).End(xlUp).Row
For j = 1 To i
Set k = Range(Cells(j, 1), Cells(j, Columns.Count).End(xlToLeft))
arr = Application.Transpose(Application.Transpose(k))
Cells(j, 5) = "" & Join(arr, "")
Next
End Sub
''Filter 函數(shù) filter(要搜索的1維數(shù)組,搜索的字符串,[True/False])
Sub filtertext() ''對數(shù)組內(nèi)容進行篩選
arr = [{"abc","bb","c","ba","dd","nba"}]
a = filter(arr, "b", True) ''數(shù)組搜索 包含 "B"
a = filter(arr, "b", False) ''數(shù)組搜索 不包含 "B"
End Sub
''支持數(shù)組的函數(shù) sumif ,countif,match,index ,vlookup
Sub indextext()
arr = [a2:C13]
arr1 = WorksheetFunction.Index(arr, 0, 2) ''取該數(shù)組的第2列 如行不為0形不成數(shù)組
arr2 = WorksheetFunction.Index(arr, 3, 0) ''去該數(shù)組的第3行
End Sub
Sub 查詢系統(tǒng)()
[F1:n99].Clear
arr = Range("A1", Cells(Rows.Count, "c").End(xlUp))
For i = 1 To UBound(arr)
If arr(i, 1) Like [e1] Then ''
n = n + 1 '' 擴展一個區(qū)域用于存放數(shù)組
Cells(n, "i").Resize(1, 3) = WorksheetFunction.Index(arr, 1, 0) ''取該數(shù)組的行
End If
Next
End Sub
Sub VBAs數(shù)組格式化單元格()
Cells.ClearFormats ''清除格式
'arr = Range("c2:c" & Cells(Rows.Count).End(xlUp).Row) ''該列形成 數(shù)組
arr = Range("c2:c10") ''該列形成 數(shù)組
For i = 1 To UBound(arr)
If arr(i, 1) > 300 Then ''
Set rng = Cells(i + 1, "e").EntireRow.Range("a1:c1") ''第2列開始 取這整行
X = rng.Address
n = n + 1
If n = 1 Then
Set rngs = rng
Else
Set rngs = Union(rngs, rng) '單元格合并
y = rngs.Address
End If
End If
Next
rngs.Interior.ColorIndex = 9
End Sub
Sub 排序()
arr = Selection
For i = 1 To UBound(arr)
For j = i + 1 To undound ''單列相互對比
If arr(i, 1) > arr(j, 1) Then
k = arr(i, 1) ''數(shù)組 位子互換
arr(i, 1) = arr(j, 1)
arr(j, 1) = k
End If
Next
Next
[g1].Resize(UBound(arr)) = arr
End Sub
Sub VBA數(shù)組分類匯總()
Dim arr1()
arr = Range("a2:c10") ''賦值區(qū)域
For i = 1 To UBound(arr)
ReDim Preserve arr1(1 To 2, 1 To n + 1)
For j = 1 To UBound(arr1, 2) '''求這個數(shù)組2維的上界
If arr1(1, j) = arr(i, 1) Then ''是否和arr 數(shù)組記錄相等
arr1(2, j) = arr1(2, j) + arr(i, 2) '' 相等就相加
GoTo 100
End If
Next
n = n + 1
arr1(1, n) = arr(i, 1) ''如果arr1 不等于arr當(dāng)前數(shù)組記錄 則把當(dāng)前的數(shù)組記錄保存在arr1中
arr1(2, n) = arr(i, 2) ''第 X行 1,2 列 記錄保存
100:
Next
[a15].Resize(n, 2) = Application.Transpose(arr1)
End Sub
