程序语言中的函数和数学中的函数基本概念是相似的。程序语言中的函数也有参数和返回值，以及定义和调用。程序中的函数，就是将一些程序语句结合在一起的部件，通过多次调用，函数可以不止一次地在程序中运行。
程序中使用函数的好处：
一是将大问题分解成许多小问题。函数可以将程序分成多个子程序段，开发者可以独立编写各个子程序，实现程序开发流程的分解。每个函数实现特定功能，我们可以针对这个函数来编写程序。计算机程序中，函数的实现千变万化。函数调用中，即使函数的实现改变了，只要函数的调用方式不变，调用它的程序就不用做任何改变。这种函数调用的结构，使得主程序精巧明了，使程序修改更加容易，程序结构变得具有一种排列紧凑、疏密得当的美感。
二是便于检测错误。一个函数写好后，我们会检测其实现的正确性。程序由多个函数组成的，我们确定每一个函数是正确后，总程序出错的可能性就会降低。另外函数的代码量小，也便于检测错误。
三是实现封装和重用。“封装”的意思是隐藏细节，应用时只需要传递相应的参数给函数，函数就会返回相应的结果，而不必关注函数操作的具体实现。“重用”的特点体现在，各个程序都可以直接调用已经写好的函数，而不用重复编写代码，这种重用提高了程序开发效率。
四是便于维护。每个函数都必须要有清楚的界面和注释，包含了功能，输入的参数、返回值的解释等。让人知道如何调用这个函数。
实际上，系统提供的函数与用户自定义函数本质上是一样的，只是前者显得更专业，速度可能快一些罢了。
对于EXCEL—VBA来说，代码往往是短小精悍的，自定义函数就非必须。但中等以上的代码量也很常见，自定义函数就能够体现出其价值。而且，从成为一个资深代码开发者的标准来看，自定义函数的知识储备与应用习惯的培养，也是必须的。
以下和大家分享一组自认为实用价值较高的自定义函数，当然函数代码仍有进一步优化的余地，这里只是抛砖引玉，开启思路，谨供参考。函数中的说明语句如果不够明确，可结合示例文件加深理解。
1、字典排序程序和字典排序数组
字典排序本质上也就是数组排序，但由于其有自己的特点和特殊应用，因此单独写了字典排序程序和函数。字典排序程序是带参数的程序，本质上仍是函数，调用执行后字典将处于排序后的状态。字典排序函数是将排序后的字典写入数组，方便下步调用。
Public Function sortdictoarr(d, key, order)
Rem 将排序后的字典写入数组
Rem 参数1为字典对象，参数2为排序关键字（1为字典键，2为字典值），参数3为升降序种类（1为升序，2为降序）
Dim ar, brr(), tmp0, tmp1, tmp2, ii, i, code, quot
ke=d.keys
it=d.items
If key=1 Then ar=ke Else ar=it
If order=1 Then code="<" Else code=">"
ReDim brr(1 To d.count, 1 To 2)
For i=0 To UBound(ar) - 1
For ii=i + 1 To UBound(ar)
If TypeName(ar(0))="String" Then quot=Chr(34) Else quot=""
tmp=Evaluate(quot & ar(ii) & quot & code & quot & ar(i) & quot)
If tmp=True Then
tmp0=ar(i): ar(i)=ar(ii): ar(ii)=tmp0
tmp1=it(i): it(i)=it(ii): it(ii)=tmp1
tmp2=ke(i): ke(i)=ke(ii): ke(ii)=tmp2
End If
Next
Next
For i=0 To UBound(ke)
brr(i + 1, 1)=ke(i)
brr(i + 1, 2)=it(i)
Next
sortdictoarr=brr
End Function
Public Sub sortdic(d, key, order)
Rem 字典排序程序
Rem 参数1为字典对象，参数2为排序关键字（1为字典键，2为字典值），参数3为升降序种类（1为升序，2为降序）
Dim ar, tmp0, tmp1, tmp2, ii, i, code, quot
ke=d.keys
it=d.items
If key=1 Then ar=ke Else ar=it
If order=1 Then code="<" Else code=">"
For i=0 To UBound(ar) - 1
For ii=i + 1 To UBound(ar)
If TypeName(ar(0))="String" Then quot=Chr(34) Else quot=""
tmp=Evaluate(quot & ar(ii) & quot & code & quot & ar(i) & quot)
If tmp=True Then
tmp0=ar(i): ar(i)=ar(ii): ar(ii)=tmp0
tmp1=it(i): it(i)=it(ii): it(ii)=tmp1
tmp2=ke(i): ke(i)=ke(ii): ke(ii)=tmp2
End If
Next
Next
d.RemoveAll
For i=0 To UBound(ke) '将排序后的数组重新写入字典
d(ke(i))=it(i)
Next
End Sub
2、数组排序函数
VBA没有为我们提供数组排序功能，这是一个缺憾。实际开发中，人们或者书写冗长的排序语句，或者干脆用单元格排序语句来变通代替，也可勉强解决问题，二者的弊端显而易见。此函数可实现最多三个关键字的排序，基本满足实战需要。如有更多关键字排序需求的，可根据此代码思路，进一步深化函数的功能。
Public Function sortarr(arr, key1, order1, Optional key2=0, Optional order2=1, Optional key3=0, Optional order3=1)
Rem 数组排序函数
Rem arr为被排序数组，含key参数为排序字段，含order参数为排序次序，key和order两两一组，最多三组，最多可对三个字段排序，后两组排序参数可省略
Dim i, ii, c, code, tmp, code1, code2, tmparr(), v1, v2, v3, v4, v5, v6, tmp0, tmp1, tmp2, tmp3, tmp4
If LBound(arr)=0 Then
Rem 一维数组排序
If order1=1 Then code="<" Else code=">"
For i=0 To UBound(arr) - 1
For ii=i + 1 To UBound(arr)
tmp=Evaluate(arr(ii) & code & arr(i))
If tmp=True Then tmp1=arr(i): arr(i)=arr(ii): arr(ii)=tmp1
Next
Next
Else
Rem 二维数组排序
ReDim tmparr(1 To UBound(arr, 2))
If key2=0 And key3=0 Then
Rem 一个关键字排序
If order1=1 Then code1="<" Else code1=">"
For i=1 To UBound(arr) - 1
For ii=i + 1 To UBound(arr)
v1=arr(ii, key1): v2=arr(i, key1)
'evaluate括号中的字符串两面要加引号
If TypeName(arr(ii, key1))="String" Then v1="""" & arr(ii, key1) & """"
If TypeName(arr(i, key1))="String" Then v2="""" & arr(i, key1) & """"
tmp=Evaluate(v1 & code1 & v2)
If tmp=True Then
For c=1 To UBound(arr, 2): tmparr(c)=arr(i, c): Next
For c=1 To UBound(arr, 2): arr(i, c)=arr(ii, c): Next
For c=1 To UBound(arr, 2): arr(ii, c)=tmparr(c): Next
End If
Next
Next
ElseIf key2 <> 0 And key3=0 Then
Rem 两个关键字排序
If order1=1 Then code1="<" Else code1=">"
If order2=1 Then code2="<" Else code2=">"
For i=1 To UBound(arr) - 1
For ii=i + 1 To UBound(arr)
v1=arr(ii, key1): v2=arr(i, key1)
If TypeName(arr(ii, key1))="String" Then v1="""" & arr(ii, key1) & """"
If TypeName(arr(i, key1))="String" Then v2="""" & arr(i, key1) & """"
tmp1=Evaluate(v1 & code1 & v2)
tmp0=Evaluate(v1 & "=" & v2)
v3=arr(ii, key2): v4=arr(i, key2)
If TypeName(arr(ii, key2))="String" Then v3="""" & arr(ii, key2) & """"
If TypeName(arr(i, key2))="String" Then v4="""" & arr(i, key2) & """"
tmp2=Evaluate(v3 & code2 & v4)
If tmp1=True Or (tmp0=True And tmp2=True) Then
For c=1 To UBound(arr, 2): tmparr(c)=arr(i, c): Next
For c=1 To UBound(arr, 2)
arr(i, c)=arr(ii, c)
Next
For c=1 To UBound(arr, 2)
arr(ii, c)=tmparr(c)
Next
End If
Next
Next
ElseIf key2 <> 0 And key3 <> 0 Then
Rem 三个关键字排序
If order1=1 Then code1="<" Else code1=">"
If order2=1 Then code2="<" Else code2=">"
If order3=1 Then code3="<" Else code3=">"
For i=1 To UBound(arr) - 1
For ii=i + 1 To UBound(arr)
v1=arr(ii, key1): v2=arr(i, key1)
If TypeName(arr(ii, key1))="String" Then v1="""" & arr(ii, key1) & """"
If TypeName(arr(i, key1))="String" Then v2="""" & arr(i, key1) & """"
tmp1=Evaluate(v1 & code1 & v2)
tmp0=Evaluate(v1 & "=" & v2)
v3=arr(ii, key2): v4=arr(i, key2)
If TypeName(arr(ii, key2))="String" Then v3="""" & arr(ii, key2) & """"
If TypeName(arr(i, key2))="String" Then v4="""" & arr(i, key2) & """"
tmp2=Evaluate(v3 & "=" & v4)
tmp3=Evaluate(v3 & code2 & v4)
v5=arr(ii, key3): v6=arr(i, key3)
If TypeName(arr(ii, key3))="String" Then v5="""" & arr(ii, key3) & """"
If TypeName(arr(i, key3))="String" Then v6="""" & arr(i, key3) & """"
tmp4=Evaluate(v5 & code2 & v6)
If tmp1=True Or (tmp0=True And tmp3=True) Or (tmp0=True And tmp2=True And tmp4=True) Then
For c=1 To UBound(arr, 2): tmparr(c)=arr(i, c): Next
For c=1 To UBound(arr, 2)
arr(i, c)=arr(ii, c)
Next
For c=1 To UBound(arr, 2)
arr(ii, c)=tmparr(c)
Next
End If
Next
Next
End If
End If
sortarr=arr
End Function
3、条件求和函数
相当于sumifs函数，但该函数在2007版本以上才有，且不能处理数组。此函数试用没有问题，但由于条件表达式多种多样，因此不敢保证在所有情况下，函数执行绝对无误。大家在应用中如发现问题，可在本贴中反馈。
Public Function sumifs(arr, c, ParamArray Other())
Rem 数组条件求和
Rem 参数1为待计算数组，参数2为被求和数组列号，参数3、4分别为比对条件列号和条件，参数5、6作用与参数3、4相同，从参数5、6开始可以设置多组条件，也可省略，类似sumifs工作表函数
Dim reg As Object, str, i, ii, n, num, he, s1, s2, s0
Set reg=CreateObject("vbscript.regexp")
reg.Global=True
reg.Pattern="^([><=]{0,2})(-?\d*\.?\d*)(%?)$"
he=0
If LBound(arr)=0 Then
Rem 一维数组
For i=0 To UBound(arr)
If reg.test(Other(0))=True Then
s0=reg.Execute(Other(0))(0).submatches(0)
s1=reg.Execute(Other(0))(0).submatches(1)
s2=reg.Execute(Other(0))(0).submatches(2)
If s2="%" Then str=s0 & (s1 - 0) / 100 Else str=Other(0) '求和条件中的百分比要转化为数值，系统方能识别
If s0="" Then str="=" & str
If Evaluate(arr(i) & str) Then he=he + arr(i) '计算条件为数值
Else
If arr(i) Like Other(0) Then he=he + arr(i) '计算条件为字符串和通配符
End If
Next
Else
Rem 二维数组
For i=1 To UBound(arr)
For ii=1 To UBound(Other) Step 2
If reg.test(Other(ii))=True Then
s0=reg.Execute(Other(ii))(0).submatches(0)
s1=reg.Execute(Other(ii))(0).submatches(1)
s2=reg.Execute(Other(ii))(0).submatches(2)
If s2="%" Then str=s0 & (s1 - 0) / 100 Else str=Other(ii)
If s0="" Then str="=" & str
If Evaluate(arr(i, Other(ii - 1)) & str) Then n=n + 1: str=""
Else
If arr(i, Other(ii - 1)) Like Other(ii) Then n=n + 1
End If
Next
If n=(UBound(Other) + 1) / 2 Then he=he + arr(i, c) '满足所有条件，则进行累加
n=0
Next
End If
sumifs=he
End Function
4、条件计数函数和条件求平均值函数
相当于countifs和averageifs函数，这两个函数与条件求和函数代码思路大同小异，不加细说。
Public Function countifs(arr, ParamArray Other())
Rem 数组条件计数函数
Rem 参数说明请参考sumifs函数
Dim reg As Object, str, i, ii, n, num, times, s1, s2, s0
Set reg=CreateObject("vbscript.regexp")
reg.Global=True
reg.Pattern="^([><=]{0,2})(-?\d*\.?\d*)(%?)$"
he=0
times=0
If LBound(arr)=0 Then
Rem 一维数组
For i=0 To UBound(arr)
If reg.test(Other(0))=True Then
s0=reg.Execute(Other(0))(0).submatches(0)
s1=reg.Execute(Other(0))(0).submatches(1)
s2=reg.Execute(Other(0))(0).submatches(2)
If s2="%" Then str=s0 & (s1 - 0) / 100 Else str=Other(0)
If s0="" Then str="=" & str
If Evaluate(arr(i) & str) Then times=times + 1
Else
If arr(i) Like Other(0) Then times=times + 1
End If
Next
Else
Rem 二维数组
For i=1 To UBound(arr)
For ii=1 To UBound(Other) Step 2
If reg.test(Other(ii))=True Then
s0=reg.Execute(Other(ii))(0).submatches(0)
s1=reg.Execute(Other(ii))(0).submatches(1)
s2=reg.Execute(Other(ii))(0).submatches(2)
If s2="%" Then str=s0 & (s1 - 0) / 100 Else str=Other(ii)
If s0="" Then str="=" & str
If Evaluate(arr(i, Other(ii - 1)) & str) Then n=n + 1: str=""
Else
If arr(i, Other(ii - 1)) Like Other(ii) Then n=n + 1
End If
Next
If n=(UBound(Other) + 1) / 2 Then times=times + 1
n=0
Next
End If
countifs=times
End Function
Public Function averageifs(arr, c, ParamArray Other())
Rem 数组条件求和
Rem 参数说明请参考sumifs函数
Dim reg As Object, str, i, ii, n, num, he, s1, s2, s0, times
Set reg=CreateObject("vbscript.regexp")
reg.Global=True
reg.Pattern="^([><=]{0,2})(-?\d*\.?\d*)(%?)$"
he=0
If LBound(arr)=0 Then
Rem 一维数组
For i=0 To UBound(arr)
If reg.test(Other(0))=True Then
s0=reg.Execute(Other(0))(0).submatches(0)
s1=reg.Execute(Other(0))(0).submatches(1)
s2=reg.Execute(Other(0))(0).submatches(2)
If s2="%" Then str=s0 & (s1 - 0) / 100 Else str=Other(0)
If s0="" Then str="=" & str
If Evaluate(arr(i) & str) Then he=he + arr(i): times=times + 1
Else
If arr(i) Like Other(0) Then he=he + arr(i): times=times + 1
End If
Next
Else
Rem 二维数组
For i=1 To UBound(arr)
For ii=1 To UBound(Other) Step 2
If reg.test(Other(ii))=True Then
s0=reg.Execute(Other(ii))(0).submatches(0)
s1=reg.Execute(Other(ii))(0).submatches(1)
s2=reg.Execute(Other(ii))(0).submatches(2)
If s2="%" Then str=s0 & (s1 - 0) / 100 Else str=Other(ii)
If s0="" Then str="=" & str
If Evaluate(arr(i, Other(ii - 1)) & str) Then n=n + 1: str=""
Else
If arr(i, Other(ii - 1)) Like Other(ii) Then n=n + 1
End If
Next
If n=(UBound(Other) + 1) / 2 Then he=he + arr(i, c): times=times + 1
n=0
Next
End If
averageifs=he / times
End Function
5、数组重排列函数
数组重排列函数在应用中比较普遍，存在多行多列数组与多行多列、一行多列、一列多行数组之间相互转换等多种变化，本函数基本能够以上各种可能。
Public Function trans(arr, Optional r=0, Optional c=0)
Rem 数组重排列函数
Rem 参数1为待排列数组，参数2为目标数组行数，参数3为目标数组列数。如对一维数组排列可只有一个参数，如对二维数组排列参数2、3只输入一个即可
Dim r1, c1, n, nn, brr(), tmp, count
If LBound(arr)=0 Then
If r > 0 Then c=Application.RoundUp((UBound(arr) + 1) / r, 0): GoTo 100
If c > 0 Then r=Application.RoundUp((UBound(arr) + 1) / c, 0)
100:
ReDim brr(1 To r, 1 To c)
For c1=1 To c
For r1=1 To r
brr(r1, c1)=arr(n)
n=n + 1
If n > UBound(arr) Then Exit For
Next
Next
Else
tmp=UBound(arr) * UBound(arr, 2)
If r > 0 Then c=Application.RoundUp(tmp / r, 0): GoTo 200
If c > 0 Then r=Application.RoundUp(tmp / c, 0)
200:
ReDim brr(1 To r, 1 To c)
nn=1
For c1=1 To c
For r1=1 To r
n=n + 1
count=count + 1
If count > tmp Then Exit For
If n > UBound(arr) Then n=1: nn=nn + 1
brr(r1, c1)=arr(n, nn)
Next
Next
End If
trans=brr
End Function
6、数组随机排列函数
Public Function sortarrbyrnd(arr)
Rem 数组随机排序函数
Dim r, c, i, ii, brr(), tmp1, tmp2, tmparr
Randomize
If LBound(arr)=0 Then '一维数组随机排序
ReDim brr(0 To UBound(arr))
For i=0 To UBound(brr) '将随机值写入辅助数组BRR，作为排序依据
brr(i)=Rnd
Next
For i=0 To UBound(brr) - 1
For ii=i + 1 To UBound(brr)
If brr(ii) < brr(i) Then
tmp1=brr(i): brr(i)=brr(ii): brr(ii)=tmp1
tmp2=arr(i): arr(i)=arr(ii): arr(ii)=tmp2
End If
Next
Next
Else '二维数组随机排序
ReDim brr(1 To UBound(arr))
ReDim tmparr(1 To UBound(arr, 2))
For i=1 To UBound(brr)
brr(i)=Rnd
Next
For i=1 To UBound(brr) - 1
For ii=i + 1 To UBound(brr)
If brr(ii) < brr(i) Then
tmp1=brr(i): brr(i)=brr(ii): brr(ii)=tmp1
For c=1 To UBound(arr, 2): tmparr(c)=arr(i, c): Next
For c=1 To UBound(arr, 2): arr(i, c)=arr(ii, c): Next
For c=1 To UBound(arr, 2): arr(ii, c)=tmparr(c): Next
End If
Next
Next
End If
sortarrbyrnd=arr
End Function
7、生成连续值判断数组函数
这里连续值定义为等比、等差序列，及其变异种类，函数结果生成一个包含连续序列起止位置的嵌套函数，方便下一步的个性化应用。
Public Function 连续值数组(arr, typenum, interval)
Rem 生成类如" array(array(a,b),array(c,d),array(e,f)) "结构的嵌套数组,例如a、b值分别为一个连续系列的起止位置
Rem 参数1为待判断数组，参数2（1为等差数列，2为等比数列），参数3为等差或等比数列的步长值
Dim brr(), i, a0, a1, flag, n, reg As Object, tmp0, tmp1, code, times
Set reg=CreateObject("vbscript.regexp")
reg.Global=True
reg.Pattern="\d+"
If typenum=1 Then code="-" Else code="/"
For i=2 To UBound(arr)
tmp0=Val(reg.Execute(arr(i - 1, 1))(0))
tmp1=Val(reg.Execute(arr(i, 1))(0))
If Evaluate(tmp1 & code & tmp0)=interval Then
If flag=0 Then a0=i - 1: flag=1
a1=i
If i=UBound(arr) Then
If flag=1 Then
times=times + 1
ReDim Preserve brr(1 To times)
brr(times)=Array(a0, a1)
End If
End If
Else
If flag=1 Then
times=times + 1
ReDim Preserve brr(1 To times)
brr(times)=Array(a0, a1)
End If
flag=0
End If
Next
连续值数组=brr
End Function
8、排名函数
如同许多工作表函数一样，RANK函数也不支持数组，更不可能实现中国式排名，给应用者带来遗憾和困扰。此函数可实现常规排名和中国式排名，在编写排名程序时可直接调用。
Public Function rank(num, arr, column0, type0)
Rem 排名函数
Rem 参数1为待排名值，参数2为数字列表数组，参数3为数组中的排序列列号，参数4（1为常规排名，2为中国式排名）
Dim i, n, str
If type0=1 Then
For i=1 To UBound(arr)
If arr(i, column0) > num Then n=n + 1
Next
ElseIf type0=2 Then
For i=1 To UBound(arr)
If arr(i, column0) > num And InStr(vbCr & str & vbCr, vbCr & arr(i, column0) & vbCr)=0 Then
str=str & vbCr & arr(i, column0)
n=n + 1
End If
Next
End If
rank=n + 1
End Function
9、简单透视表函数
通过透视处理，形成类似简单报表的数组，能够满足很多工作中的基本需求。SQL语句中有类似的转置功能，但用起来更麻烦，不如这个实用。
Public Function PivotTable(arr, rowfields, columnfields, datafields)
Rem 数组透视，将数组生成简单报表
Rem 参数1为待处理数组，参数2为报表行标题的数组列号，参数3为报表列标题的数组列号，参数4为报表数值区域的数组列号
Dim d1, d2, d3, brr(), str, k1, k2, i, ii
Set d1=CreateObject("Scripting.Dictionary")
Set d2=CreateObject("Scripting.Dictionary")
Set d3=CreateObject("Scripting.Dictionary")
For i=1 To UBound(arr)
d1(arr(i, rowfields))="" '生成行标题字典
d2(arr(i, columnfields))="" '生成列标题字典
str=arr(i, rowfields) & vbCr & arr(i, columnfields)
d3(str)=d3(str) + arr(i, datafields)
Next
ReDim brr(1 To d1.count + 1, 1 To d2.count + 1)
k1=d1.keys
k2=d2.keys
For i=2 To UBound(brr) '生成行标题
brr(i, 1)=k1(i - 2)
Next
For i=2 To UBound(brr, 2) '生成列标题
brr(1, i)=k2(i - 2)
Next
For i=2 To UBound(brr) '生成报表数值区域
For ii=2 To UBound(brr, 2)
str=brr(i, 1) & vbCr & brr(1, ii)
brr(i, ii)=d3(str)
Next
Next
Set d1=Nothing
Set d2=Nothing
Set d3=Nothing
PivotTable=brr
End Function
10、名称相似度比对函数。
规范名称与不规范名称比对，这是一些部门数据处理的难点。由于实际情况千差万别，计算机很难完美解决这种问题（人脑更强大灵活，但也不能百分百解决问题）。该函数只能明显提高比对效率，但不能达到完全准确，也需要辅以不同程度的手工处理。用户可根据数据的具体情况，对比对函数代码进行个性化的丰富完善。
Public Function 相似度比对(arr, brr, 相似比例)
Rem 主要用于不规范的企业名称模糊比对
Dim crr(), i, ii, reg, dic, times, str, str1
Set dic=CreateObject("Scripting.Dictionary")
Set reg=CreateObject("vbscript.regexp")
reg.Global=True
ReDim crr(1 To UBound(arr), 1 To 2)
For i=1 To UBound(brr) '目标数组读入字典，为比对做准备
dic(brr(i, 1))=""
Next
For i=1 To UBound(arr)
If dic.exists(arr(i, 1)) Then '相同比对
crr(i, 1)=arr(i, 1)
crr(i, 2)="相同"
Else '相似度比对
reg.Pattern="[" & arr(i, 1) & "]"
For ii=1 To UBound(brr)
times=reg.Execute(brr(ii, 1)).count
If times / Len(arr(i, 1)) >=相似比例 Then
str=str & IIf(str="", "", Chr(10)) & brr(ii, 1)
str1=str1 & " " & Round(times / Len(arr(i, 1)) * 100, 1) & "%"
End If
Next
If str <> "" Then crr(i, 1)=str: crr(i, 2)="'" & Trim(str1)
str=""
str1=""
End If
Next
相似度比对=crr
Set dic=Nothing
End Function
11、显示数组/字典内容函数
此函数方便随时显示数组或字典的内容，可在程序最后显示数组数据，可在程序执行过程中及程序调试时显示数组数据，使数组内容感性化，提高代码调试效率。
Public Function 显示数组(arr, flag, ParamArray Other())
Rem 显示数组连续行或非连续行内容，显示字典键和值的内容
Rem 参数1为数组或字典名称，参数2（1为显示连续区域，后面有起止两个参数；2为显示不连续行，后面参数不确定），参数2后面至少要有两个参数。字典名称后也要有两个参数
Dim brr(), str, r, c, i, max, k, it, max1, max2
If TypeName(arr)="Dictionary" Then
ReDim brr(1 To 2)
k=arr.keys: it=arr.items
For i=0 To UBound(k)
brr(1)=Application.max(Len(k(i)), max1)
brr(2)=Application.max(Len(k(i)), max2)
Next
For i=0 To UBound(k)
str=str & i + 1 & Chr(9) & k(i) & Space(brr(1) - Len(k(i))) & Chr(9) & it(i) & Space(brr(2) - Len(it(i)))
str=str & Chr(10)
Next
Else
ReDim brr(1 To UBound(arr, 2))
For c=1 To UBound(arr, 2)
For r=1 To UBound(arr)
max=Application.max(Len(arr(r, c)), max)
Next
brr(c)=max: max=0
Next
If flag=1 Then
For r=Other(0) To Other(1)
For c=1 To UBound(arr, 2)
str=str & IIf(c=1, r & Chr(9), Chr(9)) & arr(r, c) & Space(brr(c) - Len(arr(r, c)))
Next
str=str & Chr(10)
Next
Else
For r=0 To UBound(Other)
For c=1 To UBound(arr, 2)
str=str & IIf(c=1, Other(r) & Chr(9), Chr(9)) & arr(Other(r), c) & Space(brr(c) - Len(arr(Other(r), c)))
Next
str=str & Chr(10)
Next
End If
End If
显示数组=str
End Function
小伙伴，大家一起学习Excel VBA知识，一起进步。同时欢迎大家帮忙转发并关注，谢谢大家的支持！
联系客服
