今天在整理电脑中文件夹时，偶然发现了这样一个工作簿示例，记不清以前是在哪里下载的了。该工作簿是关于使用VBA代码编写数组函数以及在VBA中使用数组公式的示例，并且使用VBA代码删除含有数组公式的区域。现将其贴于此，供参考。
如上图所示，在工作簿的Example工作表中有三个按钮，单击第一个按钮“重置工作表”将清除工作表中的所有数据和公式，并在单元格区域A1：A5中输入数据“1，2，3，4，5”；单击第二个按钮“输入数据公式”后，将在单元格区域C1：C5中输入数组公式{=ReverseRange(A1:A5)}，ReverseRange函数为自定义函数，用于将指定区域的数据颠倒（即将原区域中从上到下的数据转为从下到上，或将自左至右的数据转为自右至左），并且在单元格区域E1:I1中输入数组公式{=TRANSPOSE(A1:A5)}，用于将指定区域的数据转置；单击第三个按钮“删除第2行”后，将删除含有数组公式的区域中的数据。
“重置工作表”按钮对应的代码为：
Sub ResetSheet()
'清除工作表中所有公式并添加要处理的示例数据 Example.Cells.Clear
Example.Range("A1:A5").Value = WorksheetFunction.Transpose(Array(1, 2, 3, 4, 5))
End Sub
“输入数据公式”按钮对应的代码为：
Sub EnterSampleArrayFormulas()
'使用代码输入数组公式示例
Dim rng As Range With Example.Range("E1:I1")
If .HasArray Then .CurrentArray.Clear
.FormulaArray = "=TRANSPOSE(A1:A5)"
End With
With Example.Range("C1:C5")
If .HasArray Then .CurrentArray.Clear
.FormulaArray = "=ReverseRange(A1:A5)"
End With
End Sub
“删除第2行”按钮对应的代码为：
Sub RemoveRow2()
'示例:修改包含数组公式的单元格区域
'首先, 将数组公式转换成一组普通的公式.
'然后修改工作表,并恢复数组公式 Dim rng As Range
Set rng = Example.Range("C1").CurrentArray
rng.Formula = rng.FormulaArray
Example.Rows(2).Delete
rng.FormulaArray = rng.Cells(1, 1).Formula
End Sub
其中，调用了三个自定义的函数：IsInArray函数、ReverseArray函数和ReverseRange函数。
Public Function IsInArray(aryIn() As Variant, item As Variant) As Boolean
'检查数据项是否在数组中 Dim i As Integer
On Error Resume Next
i = UBound(aryIn)
If Err.Number <> 0 Then
'没有初始化数组
IsInArray = False
Exit Function
End If
On Error GoTo 0
For i = LBound(aryIn) To UBound(aryIn)
If aryIn(i) = item Then
IsInArray = True
Exit Function
End If
Next i
IsInArray = False
End Function
Public Function ReverseArray(aryIn() As Variant) As Variant()
'返回数组的转置
Dim i As Integer
Dim temp() As Variant
On Error Resume Next
i = UBound(aryIn)
If Err.Number <> 0 Then
'没有初始化数组
ReverseArray = aryIn()
Exit Function
End If
On Error GoTo 0
ReDim temp(LBound(aryIn) To UBound(aryIn))
For i = LBound(aryIn) To UBound(aryIn)
temp(i) = aryIn(UBound(aryIn) + LBound(aryIn) - i)
Next i
ReverseArray = temp()
End Function
Public Function ReverseRange(rng As Range) As Variant()
'一个UDF,返回单元格区域的镜像,即上下和左右反转
Dim aryIn() As Variant
Dim a As Variant
Dim r As Integer, c As Integer
Dim temp() As Variant
'对于含单个单元格的区域, rng.Value不返回数组
'因此,对这种情况单独处理.
If rng.Cells.Count = 1 Then
ReverseRange = Array(rng.Value)
Exit Function
End If
aryIn = rng.Value
ReDim temp(LBound(aryIn) To UBound(aryIn), _
LBound(aryIn, 2) To UBound(aryIn, 2))
'遍历数组中所有的行和列
'并使用转置后的数据填充temp()
For r = LBound(aryIn) To UBound(aryIn)
For c = LBound(aryIn, 2) To UBound(aryIn, 2)
temp(r, c) = aryIn(UBound(aryIn) + LBound(aryIn) - r, _
UBound(aryIn, 2) + LBound(aryIn, 2) - c)
Next c
Next r
ReverseRange = temp()
End Function
示例工作簿下载：Arrays.xls
Loading ...
