数组

'数组声明方式
Sub 静态数组()
'VBA数组默认从0开始索引，除非明确指定下限，如例子明确了下限是1开始到7结束
Dim days(1 To 7) As String '注意确定范围，如这里1 to 7
days(1) = "星期一"
days(2) = "星期二"
MsgBox days(1) & Chr(10) & days(2)
End Sub
Sub 动态数组()
'注意事项：使用ReDim会清除数组原有数据;动态数组使用前必须用ReDim确定大小
' 声明动态数组
Dim students() As String
Dim num As Integer
' 获取学生数量
num = Application.InputBox("请输入学生人数", "数组大小", 3, , , , 1) '最后一个参数限定输入内容的类型，1数字，2文本，4逻辑值，8单元格
' 重新定义数组大小
ReDim students(1 To num)
' 数组填充内容
For i = 1 To num
students(i) = Application.InputBox("请输入第" & i & "位学生名字: ", "写入姓名", "zhangxt", , , , , 2)
Next
' 显示所有学生
For i = 1 To num
msg = msg & "学生" & i & "：" & students(i) & Chr(10)
Next
MsgBox msg
End Sub
'数组基本操作
Sub 遍历数组()
'注意事项：始终使用LBound和UBound获取数组边界，使代码更健壮；避免使用硬编码的索引值（如For i = 1 To 3）
'使用array创建数组，默认从0开始
Dim colors
colors = Array("blue", "red", "yellow")
For i = LBound(colors) To UBound(colors)
Debug.Print colors(i)
Next
For i = LBound(colors) To UBound(colors)
Range("a1").Offset(i) = colors(i)
Next
End Sub
'多维数组
Sub 多维数组()
Dim names(1 To 3, 1 To 3)
For i = 1 To UBound(names, 1)
For j = 1 To UBound(names, 2)
names(i, j) = i * j
Next
Next
Range("a1").Resize(UBound(names, 1), UBound(names, 2)) = names
'Range("A1:C3").Value = matrix
End Sub
Sub UBoundExample()
' 声明一个3x4的二维数组
Dim myArray(1 To 3, 1 To 4) As String
Dim i As Integer, j As Integer
'填充数组
For i = 1 To 3
For j = 1 To 4
myArray(i, j) = "行" & i & "列" & j
Next j
Next i
' 使用UBound获取各维度上界
Dim firstDimUpper As Integer
Dim secondDimUpper As Integer
firstDimUpper = UBound(myArray, 1) '获取第一维的上界
secondDimUpper = UBound(myArray, 2) ' 获取第二维的上界
'显示结果
MsgBox "数组第一维(行)的上界是: " & firstDimUpper & vbCrLf & _
"数组第二维(列)的上界是: " & secondDimUpper
' 动态遍历数组(即使不知道数组大小)
For i = LBound(myArray, 1) To UBound(myArray, 1)
For j = LBound(myArray, 2) To UBound(myArray, 2)
Debug.Print myArray(i, j)
Next j
Next i
End Sub
'数组常用函数
'Split和Join函数
Sub Fun_split()
Dim fruits1 As String, fruits2 As String, fru
fruits1 = "苹果,香蕉,梨子,水蜜桃"
fru = Split(fruits1, ",")
fru(0) = "甘蔗"
fruits2 = Join(fru, ",")
MsgBox fruits2
End Sub
Sub SheetArrayInteraction()
' 从工作表读取数据到数组
Dim dataArr As Variant
dataArr = Range("A1:C10").Value
' 处理数据（示例：将第二列值加倍）
Dim i As Integer
For i = LBound(dataArr, 1) To UBound(dataArr, 1)
If IsNumeric(dataArr(i, 2)) Then
dataArr(i, 2) = dataArr(i, 2) * 2
End If
Next i
'crr = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(dataArr))
' 将处理后的数据写回工作表（E1:G10区域）
Range("e1").Resize(UBound(dataArr, 1), UBound(dataArr, 2)) = dataArr
MsgBox "数据处理完成！"
End Sub
Sub ArrayErrorHandling()

On Error GoTo ErrorHandler
Dim arr(1 To 5) As Integer
Dim i As Integer
' 正常填充数组
For i = 1 To 5
    arr(i) = i * 10
Next i
' 故意引发错误（访问不存在的元素）
MsgBox "第6个元素的值是：" & arr(6)
Exit Sub

ErrorHandler:
MsgBox "发生错误：" & Err.Description & vbCrLf & _
"错误号：" & Err.Number & vbCrLf & _
"请检查数组边界！"
End Sub

Sub 类型错误()
On Error GoTo errhandler
Dim arr(1 To 7) As Integer
arr(1) = 1
arr(2) = "zhangxt"
s = Join(arr, ",")
MsgBox s
errhandler:
MsgBox "错误代码：" & Err.Number & vbCrLf & _
"错误描述：" & Err.Description & vbCrLf & _
"注意数据类型"
End Sub

Sub PerformanceDemo()
Dim startTime As Double
Dim i As Long, j As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)

' 方法1：逐个单元格操作（慢）
startTime = Timer
For i = 1 To 1000
For j = 1 To 10
ws.Cells(i, j).Value = i * j
Next j
Next i
Debug.Print "逐个单元格操作耗时：" & Timer - startTime & "秒"

' 方法2：使用数组批量操作（快）
startTime = Timer
Dim fastArr(1 To 1000, 1 To 10) As Long

' 填充数组
For i = 1 To 1000
For j = 1 To 10
fastArr(i, j) = i * j
Next j
Next i

' 一次性写入工作表
ws.Range("A1:J1000").Value = fastArr
Debug.Print "数组批量操作耗时：" & Timer - startTime & "秒"

End Sub