VBA是Office自带的，无需再安装。若使用WPS，需安装VBA插件；以下是实现代码。Office或WPS电脑端用户须已安装VBA且必须启用宏才能使用。
工作表TEXTJOIN函数实现代码：
Function TEXTJOIN(ByVal 分隔符, ByVal 忽略空值1不忽略0, ParamArray 字符串())
'每个参数都允许传入（1个字符串|N个单元格区域|1-60维数组），根据第二参数来输出，结果允许是1个字符串或一维数组或二维数组。（暂不支持输出≥3维的数组，请原谅我太懒）
On Error Resume Next
Dim 一维下标 As Long, 一维上标 As Long, 二维下标 As Long, 二维上标 As Long, di As Long, 计数 As Long
Dim 忽略字符串空值 As Variant, 不忽略字符串空值 As Variant, 忽略or不忽略 As Boolean, 非数组 As Boolean
Dim 子串 As Variant, 子串1 As Variant, DicPut() ' As Variant
If IsMissing(分隔符) Then 分隔符 = vbNullString '设置[分隔符]缺省值
If IsMissing(忽略空值1不忽略0) Then 忽略空值1不忽略0 = True '设置[忽略空值1不忽略0]缺省值
忽略字符串空值 = Null: 不忽略字符串空值 = Null '下方使用IS类函数判断，但循环上亿次时会卡顿。【减少了所需变量，牺牲了速度】
'确定[分隔符]的值的总个数；'若[分隔符]没有错误值，[分隔符]转为下标从?开始的一维数组。
If IsObject(分隔符) Then 分隔符 = 分隔符.Value '不采用 VarType/TypeName，提速。（下同） '【只取首个区域的值，因考虑到国内几乎没人专门喜欢多区域传递，故而偷懒】
If IsArray(分隔符) Then
计数 = 1 '初始化
For di = 1 To 60 '确定维数/值个数。（下同）
TEXTJOIN = Null: TEXTJOIN = LBound(分隔符, di): If IsNull(TEXTJOIN) Then di = di - 1: Exit For Else 计数 = 计数 * (UBound(分隔符, di) - TEXTJOIN + 1)
Next
If di = 1 Then '一维
For 一维下标 = LBound(分隔符, 1) To UBound(分隔符, 1) '1可以省略，但速度不能提升，为了便于阅读，故而保留。（下同）
If IsError(分隔符(一维下标)) Then 忽略字符串空值 = 分隔符(一维下标): 不忽略字符串空值 = 忽略字符串空值: Exit For '检测错误值/降维。（下同）
If VarType(分隔符(一维下标)) = vbDate Then 分隔符(一维下标) = 分隔符(一维下标) * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
Next
ElseIf di = 2 Then '二维
ReDim Preserve DicPut(1 To 计数): di = 0 '设为下标从1开始的一维空数组。
TEXTJOIN = LBound(分隔符, 2): 二维上标 = UBound(分隔符, 2) '提前赋值给变量，减少内层循环所需变量的重复计算。（下同）
For 一维下标 = LBound(分隔符, 1) To UBound(分隔符, 1) '从上到下，循环行。（下同）
For 二维下标 = TEXTJOIN To 二维上标 'LBound(分隔符, 2) To UBound(分隔符, 2) '从左到右，循环列。（下同）
If IsError(分隔符(一维下标, 二维下标)) Then 忽略字符串空值 = 分隔符(一维下标, 二维下标): 不忽略字符串空值 = 忽略字符串空值: Exit For
di = di + 1: If VarType(分隔符(一维下标, 二维下标)) = vbDate Then DicPut(di) = 分隔符(一维下标, 二维下标) * 1 Else DicPut(di) = 分隔符(一维下标, 二维下标) 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
Next
If IsNull(忽略字符串空值) Then Else Exit For
Next
If IsNull(忽略字符串空值) Then 分隔符 = DicPut()
Else '三维或以上
ReDim Preserve DicPut(1 To 计数): di = 0 '设为下标从1开始的一维空数组。
分隔符 = Application.Transpose(分隔符) '转置后遍历顺序先从左到右再从上到下，Office或WPS的EXCEL内使用时生效。（下同）
For Each TEXTJOIN In 分隔符
If IsError(TEXTJOIN) Then 忽略字符串空值 = TEXTJOIN: 不忽略字符串空值 = TEXTJOIN: Exit For
di = di + 1: If VarType(TEXTJOIN) = vbDate Then DicPut(di) = TEXTJOIN * 1 Else DicPut(di) = TEXTJOIN 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
Next
If IsNull(忽略字符串空值) Then 分隔符 = DicPut()
End If
Else '非数组
If IsError(分隔符) Then 忽略字符串空值 = 分隔符: 不忽略字符串空值 = 分隔符 Else 分隔符 = Array(分隔符)
End If
'将参数[忽略空值1不忽略0]转为数组，提前遍历[忽略空值1不忽略0]一遍得到所需的首个返回值。【减少了代码量，牺牲了速度】
If IsObject(忽略空值1不忽略0) Then 忽略空值1不忽略0 = 忽略空值1不忽略0.Value
If IsArray(忽略空值1不忽略0) Then Else 非数组 = True: 忽略空值1不忽略0 = Array(忽略空值1不忽略0) '若非数组，则先转为一维数组，最后再转为字符串。【减少了代码量，牺牲了速度】
'当[分隔符]不存在错误值时执行此IF过程。
If IsNull(忽略字符串空值) Then
'确定[字符串]的值的总个数，创建下标从1开始的一维空数组（即不忽略空值时的[字符串]的值的总个数）。
For Each 子串 In 字符串 '【对象变量循环赋值给子串，牺牲了速度】
If IsMissing(子串) Then '子串无参数传递
一维上标 = 一维上标 + 1
Else '子串有参数传递
If IsObject(子串) Then
一维上标 = 一维上标 + 子串.Areas(1).Count '【只取首个区域的值，因考虑到国内几乎没人专门喜欢多区域传递，故而偷懒】
ElseIf IsArray(子串) Then
di = 1 '初始化
For 计数 = 1 To 60
TEXTJOIN = Null: TEXTJOIN = LBound(子串, 计数): If IsNull(TEXTJOIN) Then Exit For Else di = di * (UBound(子串, 计数) - TEXTJOIN + 1)
Next
一维上标 = 一维上标 + di
Else '非数组
一维上标 = 一维上标 + 1
End If
End If
Next
If 一维上标 Then
di = 0
For Each 子串 In 忽略空值1不忽略0
子串 = 子串 * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
If IsNumeric(子串) Then '是数值或布尔
If IsNull(忽略字符串空值) Or IsNull(不忽略字符串空值) Then
If 子串 Then '忽略空值时。（下同）
If IsNull(忽略字符串空值) Then 忽略or不忽略 = True Else GoTo 跳转
Else '不忽略空值时。（下同）
If IsNull(不忽略字符串空值) Then 忽略or不忽略 = False Else GoTo 跳转
End If
If di Then di = 0 Else ReDim DicPut(1 To 一维上标) '只创建一次一维空数组；某些过程情况下 ReDim Preserve 比 ReDim 速度快。
For Each 子串1 In 字符串 '【对象变量循环赋值给子串1，牺牲了速度】
If IsMissing(子串1) Then '子串1无参数传递
If 忽略or不忽略 Then Else di = di + 1: DicPut(di) = vbNullString '若[子串1]没有参数传递，且不忽略[字符串]中的空值，赋值为空值(vbNullString|Empty|"")。
Else '子串1有参数传递
If IsObject(子串1) Then 子串1 = 子串1.Value '【只取首个区域的值，因考虑到国内几乎没人专门喜欢多区域传递，故而偷懒】
If IsArray(子串1) Then
For 计数 = 2 To 3
TEXTJOIN = Null: TEXTJOIN = LBound(子串1, 计数): If IsNull(TEXTJOIN) Then 计数 = 计数 - 1: Exit For
Next
If 计数 = 1 Then '一维
For 一维下标 = LBound(子串1, 1) To UBound(子串1, 1)
If IsError(子串1(一维下标)) Then 忽略字符串空值 = 子串1(一维下标): 不忽略字符串空值 = 忽略字符串空值: GoTo 跳转
If 忽略or不忽略 Then
If Len(子串1(一维下标)) Then
di = di + 1: DicPut(di) = 子串1(一维下标): If VarType(子串1(一维下标)) = vbDate Then DicPut(di) = 子串1(一维下标) * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Else
di = di + 1: DicPut(di) = 子串1(一维下标): If VarType(子串1(一维下标)) = vbDate Then DicPut(di) = 子串1(一维下标) * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Next
ElseIf 计数 = 2 Then '二维
TEXTJOIN = LBound(子串1, 2): 二维上标 = UBound(子串1, 2)
For 一维下标 = LBound(子串1, 1) To UBound(子串1, 1)
For 二维下标 = TEXTJOIN To 二维上标
If IsError(子串1(一维下标, 二维下标)) Then 忽略字符串空值 = 子串1(一维下标, 二维下标): 不忽略字符串空值 = 忽略字符串空值: GoTo 跳转
If 忽略or不忽略 Then
If Len(子串1(一维下标, 二维下标)) Then
di = di + 1: DicPut(di) = 子串1(一维下标, 二维下标): If VarType(子串1(一维下标, 二维下标)) = vbDate Then DicPut(di) = 子串1(一维下标, 二维下标) * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Else
di = di + 1: DicPut(di) = 子串1(一维下标, 二维下标): If VarType(子串1(一维下标, 二维下标)) = vbDate Then DicPut(di) = 子串1(一维下标, 二维下标) * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Next
Next
Else '三维或以上
子串1 = Application.Transpose(子串1)
For Each TEXTJOIN In 子串1
If IsError(TEXTJOIN) Then 忽略字符串空值 = TEXTJOIN: 不忽略字符串空值 = TEXTJOIN: GoTo 跳转
If 忽略or不忽略 Then
If Len(TEXTJOIN) Then
di = di + 1: DicPut(di) = TEXTJOIN: If VarType(TEXTJOIN) = vbDate Then DicPut(di) = TEXTJOIN * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Else
di = di + 1: DicPut(di) = TEXTJOIN: If VarType(TEXTJOIN) = vbDate Then DicPut(di) = TEXTJOIN * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Next
End If
Else '非数组
If IsError(子串1) Then 忽略字符串空值 = 子串1: 不忽略字符串空值 = 子串1: GoTo 跳转
If 忽略or不忽略 Then
If Len(子串1) Then
di = di + 1: DicPut(di) = 子串1: If VarType(子串1) = vbDate Then DicPut(di) = 子串1 * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Else
di = di + 1: DicPut(di) = 子串1: If VarType(子串1) = vbDate Then DicPut(di) = 子串1 * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
End If
End If
Next
If di Then '若[字符串]存在有效值。
If di = 1 Then '[字符串]仅1个有效值，不连接[分隔符]的值。
If 忽略or不忽略 Then
忽略字符串空值 = DicPut(1): If VarType(忽略字符串空值) <> vbString Then 忽略字符串空值 = vbNullString: 忽略字符串空值 = CStr(DicPut(1))
Else
不忽略字符串空值 = DicPut(1): If VarType(不忽略字符串空值) <> vbString Then 不忽略字符串空值 = vbNullString: 不忽略字符串空值 = CStr(DicPut(1))
End If
Else '[字符串]存在2个或以上有效值，连接[分隔符]的值。
一维下标 = LBound(分隔符, 1): TEXTJOIN = UBound(分隔符, 1) '获取[分隔符]的一维下标和一维上标。
If 一维下标 = TEXTJOIN Then '[分隔符]仅1个有效值，不循环[分隔符]的值。
If 忽略or不忽略 Then
If di < 一维上标 Then '若有效值个数小于[字符串]的一维上标。
子串1 = DicPut(): ReDim Preserve 子串1(1 To di)
忽略字符串空值 = Join(子串1, 分隔符(一维下标)): If VarType(忽略字符串空值) <> vbString Then 忽略字符串空值 = vbNullString
Else
忽略字符串空值 = Join(DicPut(), 分隔符(一维下标)): If VarType(忽略字符串空值) <> vbString Then 忽略字符串空值 = vbNullString
End If
Else
不忽略字符串空值 = Join(DicPut(), 分隔符(一维下标)): If VarType(不忽略字符串空值) <> vbString Then 不忽略字符串空值 = vbNullString
End If
Else '[分隔符]存在2个或以上有效值，创建下标从1开始的一维空数组 ,循环[分隔符]的值，赋值后合并。
ReDim 子串1(1 To 2 * di - 1): 二维下标 = 一维下标 - 1 ': di = 0
For 计数 = 1 To UBound(子串1, 1) ' Step 2
子串1(2 * 计数 - 1) = DicPut(计数) '子串1(计数) = DicPut(计数 - di): di = di + 1 '奇数索引号赋值。
二维下标 = 二维下标 + 1: If 二维下标 > TEXTJOIN Then 二维下标 = 一维下标 '循环[分隔符]的值。
子串1(2 * 计数) = 分隔符(二维下标) '子串1(计数 + 1) = 分隔符(二维下标) '偶数索引号赋值。
Next
If 忽略or不忽略 Then 忽略字符串空值 = vbNullString: 忽略字符串空值 = Join(子串1, vbNullString) Else 不忽略字符串空值 = vbNullString: 不忽略字符串空值 = Join(子串1, vbNullString)
GoTo 跳转
End If
End If
Else '若[字符串]没有参数传递，赋值为空值("")。
If 忽略or不忽略 Then 忽略字符串空值 = vbNullString Else 不忽略字符串空值 = vbNullString
End If
Else
Exit For '若获得了首个合并值，退出循环。
End If
End If
跳转:
Next
Else '若[字符串]没有参数传递，赋值为空值("")。
忽略字符串空值 = vbNullString: 不忽略字符串空值 = vbNullString
End If
End If
TEXTJOIN = CVErr(2015) '设置返回错误值
一维下标 = LBound(忽略空值1不忽略0, 1): 一维上标 = UBound(忽略空值1不忽略0, 1): 子串 = Null: 子串 = LBound(忽略空值1不忽略0, 2)
If IsNull(子串) Then '一维
For 计数 = 一维下标 To 一维上标
'忽略空值1不忽略0(计数) = 忽略空值1不忽略0(计数) * 1
二维下标 = VarType(忽略空值1不忽略0(计数))
If 二维下标 = vbError Then '本身的错误值不处理，非数值或非布尔值返回#VALUE!（下同）
ElseIf 二维下标 = vbString Then
忽略空值1不忽略0(计数) = TEXTJOIN
ElseIf IsNumeric(忽略空值1不忽略0(计数)) Then '是数值或布尔。（下同）
If 忽略空值1不忽略0(计数) Then
忽略空值1不忽略0(计数) = 忽略字符串空值 '读取首个值。（下同）
Else
忽略空值1不忽略0(计数) = 不忽略字符串空值 '读取首个值。（下同）
End If
End If
Next
If 非数组 Then TEXTJOIN = 忽略空值1不忽略0(一维下标) Else TEXTJOIN = 忽略空值1不忽略0
Else '二维
二维上标 = UBound(忽略空值1不忽略0, 2) ': 二维下标 = 子串
For 计数 = 一维下标 To 一维上标
For di = 子串 To 二维上标
'忽略空值1不忽略0(计数, di) = 忽略空值1不忽略0(计数, di) * 1
二维下标 = VarType(忽略空值1不忽略0(计数, di))
If 二维下标 = vbError Then
ElseIf 二维下标 = vbString Then
忽略空值1不忽略0(计数, di) = TEXTJOIN
ElseIf IsNumeric(忽略空值1不忽略0(计数, di)) Then
If 忽略空值1不忽略0(计数, di) Then
忽略空值1不忽略0(计数, di) = 忽略字符串空值
Else
忽略空值1不忽略0(计数, di) = 不忽略字符串空值
End If
End If
Next
Next
TEXTJOIN = 忽略空值1不忽略0
End If
End Function工作表CONCAT函数实现代码：
Function CONCAT(ParamArray 字符串()) '每个参数都允许传入（1个字符串|N个单元格区域|1-60维数组），输出结果为1个字符串。
On Error Resume Next
Dim 下标 As Long, 上标 As Long, di As Long, 计数 As Long
Dim 子串 As Variant, DicPut() As Variant
'确定[字符串]的值的总个数，创建下标从1开始的一维空数组。
For Each 子串 In 字符串 '【对象变量循环赋值给子串，牺牲了速度】。（下同）
If IsMissing(子串) Then 'If Not IsMissing(子串) Then '不采用 Not，提速。（下同）
Else
If IsObject(子串) Then '不采用 VarType/TypeName，提速。（下同）
上标 = 上标 + 子串.Areas(1).Count '【只取首个区域的值，因考虑到国内几乎没人专门喜欢多区域传递，故而偷懒】
ElseIf IsArray(子串) Then
di = 1 '初始化
For 计数 = 1 To 60 '确定维数/值个数。（下同）
CONCAT = Null: CONCAT = LBound(子串, 计数): If IsNull(CONCAT) Then Exit For Else di = di * (UBound(子串, 计数) - CONCAT + 1)
Next
上标 = 上标 + di
Else '非数组
上标 = 上标 + 1
End If
End If
Next
If 上标 Then ReDim Preserve DicPut(1 To 上标): di = 0 Else CONCAT = vbNullString: Exit Function
For Each 子串 In 字符串
If IsMissing(子串) Then
Else
If IsObject(子串) Then 子串 = 子串.Value '【只取首个区域的值，因考虑到国内几乎没人专门喜欢多区域传递，故而偷懒】
If IsArray(子串) Then
For 计数 = 2 To 3
CONCAT = Null: CONCAT = LBound(子串, 计数): If IsNull(CONCAT) Then 计数 = 计数 - 1: Exit For
Next
If 计数 = 1 Then '一维
For 计数 = LBound(子串, 1) To UBound(子串, 1) '1可以省略，但速度不能提升，为了便于阅读，故而保留。（下同）
If IsError(子串(计数)) Then CONCAT = 子串(计数): Exit Function
If Len(子串(计数)) Then
di = di + 1: DicPut(di) = 子串(计数): If VarType(子串(计数)) = vbDate Then DicPut(di) = 子串(计数) * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Next
ElseIf 计数 = 2 Then '二维
CONCAT = LBound(子串, 2): 上标 = UBound(子串, 2) '提前赋值给变量，减少内层循环所需变量的重复计算。
For 计数 = LBound(子串, 1) To UBound(子串, 1) '从上到下，循环行。
For 下标 = CONCAT To 上标 'LBound(子串, 2) To UBound(子串, 2) '从左到右，循环列。
If IsError(子串(计数, 下标)) Then CONCAT = 子串(计数, 下标): Exit Function
If Len(子串(计数, 下标)) Then
di = di + 1: DicPut(di) = 子串(计数, 下标): If VarType(子串(计数, 下标)) = vbDate Then DicPut(di) = 子串(计数, 下标) * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Next
Next
Else '三维或以上
子串 = Application.Transpose(子串) '转置后遍历顺序先从左到右再从上到下，Office或WPS的EXCEL内使用时生效。
For Each CONCAT In 子串
If IsError(CONCAT) Then Exit Function
If Len(CONCAT) Then
di = di + 1: DicPut(di) = CONCAT: If VarType(CONCAT) = vbDate Then DicPut(di) = CONCAT * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
Next
End If
Else '非数组
If IsError(子串) Then CONCAT = 子串: Exit Function
If Len(子串) Then
di = di + 1: DicPut(di) = 子串: If VarType(子串) = vbDate Then DicPut(di) = 子串 * 1 'VBA缺陷，乘1是为了兼容微软把日期时间等数据类型转为数值。
End If
End If
End If
Next
CONCAT = vbNullString: If di Then CONCAT = Join(DicPut(), vbNullString) 'Join内置函数按空值合并时，[空分隔符]速度比较： vbNullString > Empty > ""
End Function工作表FILTER FILTER1 函数实现代码：
Function FILTER(ByVal 数组, ByVal 包括, Optional ByRef 空值) '空值 = CVErr(2050)【老版本Offie或WPS不兼容把可选参数设置为错误值。】
'每个参数都允许传入（1个字符串|1个单元格区域|1-2维数组），根据第二参数来输出，结果允许是1个字符串或一维数组或二维数组。（暂不支持输出≥3维的数组，请原谅我太懒）
On Error Resume Next
Dim 一维下标 As Long, 一维上标 As Long, 二维下标 As Long, 二维上标 As Long, R1 As Long, C1 As Long, 计数 As Long, X As Long, 变量 As Variant, arr() As Boolean
If IsMissing(数组) Then FILTER = CVErr(2015): Exit Function '[数组]设置缺省值
If IsMissing(包括) Then FILTER = CVErr(2015): Exit Function '[包括]设置缺省值
If IsMissing(空值) Then 空值 = CVErr(2000) 'CVErr(2050) '[空值]设置缺省值【老版本Office或WPS不兼容输出为#CALC!，暂用#NUll!代替】
If IsObject(数组) Then
If 数组.Areas.Count > 1 Then FILTER = CVErr(2023): Exit Function Else 数组 = 数组.Value '采用微软做法，即当传入多个区域时，输出为#REF!
End If
If IsArray(数组) Then Else 数组 = Array(数组) '非数组
'得到[数组]维数大小
FILTER = Null: FILTER = LBound(数组, 2): 一维下标 = LBound(数组, 1): 一维上标 = UBound(数组, 1): If 一维下标 > 一维上标 Then FILTER = 数组: Exit Function '若一维数组[数组]<无变量>，不处理
If IsNull(FILTER) Then 二维下标 = 一维下标: 二维上标 = 一维上标: 计数 = 1 Else 二维下标 = FILTER: 二维上标 = UBound(数组, 2): 计数 = 一维上标 - 一维下标 + 1
'If IsNull(FILTER) Then 计数 = 1 Else 计数 = 一维上标 - 一维下标 + 1
'确认[包括]
If IsObject(包括) Then
If 包括.Areas.Count > 1 Then FILTER = CVErr(2023): Exit Function Else 包括 = 包括.Value '采用微软做法，即当传入多个区域时，输出为#REF!
End If
If IsArray(包括) Then '[包括]是数组
变量 = Null: 变量 = LBound(包括, 2): R1 = LBound(包括, 1): C1 = UBound(包括, 1): If R1 > C1 Then FILTER = 包括: Exit Function '若一维数组[包括]<无变量>，不处理
If IsNull(变量) Then '[包括]一维
If R1 = C1 Then 包括 = 包括(R1): GoTo 包括为一个值
If C1 - R1 <> 二维上标 - 二维下标 Then FILTER = CVErr(2015): Exit Function '列数不一致
If IsNull(FILTER) Then '[数组]一维
'ReDim 变量(1 To 二维上标 - 二维下标 + 1) As Variant
计数 = 一维下标 - 1
R1 = R1 - 1
For C1 = 一维下标 To 一维上标
R1 = R1 + 1
If IsError(包括(R1)) Then FILTER = 包括(R1): Exit Function Else 包括(R1) = 包括(R1) * 1
If IsNumeric(包括(R1)) Then Else FILTER = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括(R1) Then 计数 = 计数 + 1: 数组(计数) = 数组(C1)
Next
If 计数 <> 一维下标 - 1 Then ReDim Preserve 数组(1 To 计数 - 一维下标 + 1): FILTER = 数组: Exit Function Else FILTER = 空值: Exit Function
Else '[数组]二维
'ReDim 变量(1 To 计数, 二维上标 - 二维下标 + 1) As Variant
计数 = 二维下标 - 1
二维上标 = 计数
For R1 = R1 To C1
二维上标 = 二维上标 + 1
If IsError(包括(R1)) Then FILTER = 包括(R1): Exit Function Else 包括(R1) = 包括(R1) * 1
If IsNumeric(包括(R1)) Then Else FILTER = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括(R1) Then
计数 = 计数 + 1
For C1 = 一维下标 To 一维上标
数组(C1, 计数) = 数组(C1, 二维上标)
Next
End If
Next
If 计数 <> 二维下标 - 1 Then ReDim Preserve 数组(一维下标 To 一维上标, 1 To 计数 - 二维下标 + 1): FILTER = 数组: Exit Function Else FILTER = 空值: Exit Function
End If
Else '[包括]二维
If R1 = C1 And 变量 = UBound(包括, 2) Then 包括 = 包括(R1, 变量): GoTo 包括为一个值
If R1 = C1 Then '[包括]二维，一行
If UBound(包括, 2) - 变量 <> 二维上标 - 二维下标 Then FILTER = CVErr(2015): Exit Function '列数不一致
If IsNull(FILTER) Then '[数组]一维
计数 = 一维下标 - 1
一维上标 = 一维下标 - 1
For C1 = 变量 To UBound(包括, 2)
一维上标 = 一维上标 + 1
If IsError(包括(R1, C1)) Then FILTER = 包括(R1, C1): Exit Function Else 包括(R1, C1) = 包括(R1, C1) * 1
If IsNumeric(包括(R1, C1)) Then Else FILTER = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括(R1, C1) Then 计数 = 计数 + 1: 数组(计数) = 数组(一维上标)
Next
If 计数 <> 一维下标 - 1 Then ReDim Preserve 数组(1 To 计数 - 一维下标 + 1): FILTER = 数组: Exit Function Else FILTER = 空值: Exit Function
Else '[数组]二维
计数 = 二维下标 - 1
二维上标 = 计数
For C1 = 变量 To UBound(包括, 2)
二维上标 = 二维上标 + 1
If IsError(包括(R1, C1)) Then FILTER = 包括(R1, C1): Exit Function Else 包括(R1, C1) = 包括(R1, C1) * 1
If IsNumeric(包括(R1, C1)) Then Else FILTER = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括(R1, C1) Then
计数 = 计数 + 1
For X = 一维下标 To 一维上标
数组(X, 计数) = 数组(X, 二维上标)
Next
End If
Next
If 计数 <> 二维下标 - 1 Then ReDim Preserve 数组(一维下标 To 一维上标, 1 To 计数 - 二维下标 + 1): FILTER = 数组: Exit Function Else FILTER = 空值: Exit Function
End If
ElseIf 变量 = UBound(包括, 2) Then '[包括]二维，一列
If C1 - R1 + 1 <> 计数 Then FILTER = CVErr(2015): Exit Function '行数不一致
'此时[数组]必定是二维，且[数组]第一维的个数（行数）>1
'确定结果数组的行数。
ReDim Preserve arr(一维下标 To 一维上标)
'交换 '赋值给已定义的变量类型，提速
计数 = 变量: 变量 = C1: C1 = 计数: 计数 = 0: X = 一维下标 - 1
For R1 = R1 To 变量 'C1
If IsError(包括(R1, C1)) Then FILTER = 包括(R1, C1): Exit Function Else 包括(R1, C1) = 包括(R1, C1) * 1
If IsNumeric(包括(R1, C1)) Then Else FILTER = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
X = X + 1: If 包括(R1, C1) Then 计数 = 计数 + 1: arr(X) = True
Next
If 计数 Then ReDim 变量(1 To 计数, 1 To 二维上标 - 二维下标 + 1) As Variant: 计数 = 0 Else FILTER = 空值: Exit Function
For 一维下标 = 一维下标 To 一维上标
If arr(一维下标) Then
计数 = 计数 + 1 '[变量]行数累加
X = 0 '[变量]列数初始化
For C1 = 二维下标 To 二维上标
X = X + 1: 变量(计数, X) = 数组(一维下标, C1)
Next
End If
Next
FILTER = 变量: Exit Function
Else
FILTER = CVErr(2015): Exit Function '[包括]非单行或非单列
End If
End If
Else '[包括]非数组
包括为一个值:
If 二维下标 = 二维上标 Or 计数 = 1 Then '[数组]一行或一列
If IsError(包括) Then FILTER = 包括: Exit Function
包括 = 包括 * 1
If IsNumeric(包括) Then Else FILTER = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括 Then FILTER = 数组: Exit Function Else FILTER = 空值: Exit Function
Else
FILTER = CVErr(2015): Exit Function
End If
End If
End Function
Function FILTER1(ByVal 数组, ByVal 包括, Optional ByRef 空值) '空值 = CVErr(2050)【老版本Offie或WPS不兼容把可选参数设置为错误值。】
'每个参数都允许传入（1个字符串|1个单元格区域|1-2维数组），根据第二参数来输出，结果允许是1个字符串或一维数组或二维数组。（暂不支持输出≥3维的数组，请原谅我太懒）
On Error Resume Next
Dim 一维下标 As Long, 一维上标 As Long, 二维下标 As Long, 二维上标 As Long, R1 As Long, C1 As Long, 计数 As Long, X As Long, 变量 As Variant, arr() As Boolean
If IsMissing(数组) Then FILTER1 = CVErr(2015): Exit Function '[数组]设置缺省值
If IsMissing(包括) Then FILTER1 = CVErr(2015): Exit Function '[包括]设置缺省值
If IsMissing(空值) Then 空值 = CVErr(2000) 'CVErr(2050) '[空值]设置缺省值【老版本Office或WPS不兼容输出为#CALC!，暂用#NUll!代替】
If IsObject(数组) Then
If 数组.Areas.Count > 1 Then FILTER1 = CVErr(2023): Exit Function Else 数组 = 数组.Value '采用微软做法，即当传入多个区域时，输出为#REF!
End If
If IsArray(数组) Then Else 数组 = Array(数组) '非数组
'得到[数组]维数大小
FILTER1 = Null: FILTER1 = LBound(数组, 2): 一维下标 = LBound(数组, 1): 一维上标 = UBound(数组, 1): If 一维下标 > 一维上标 Then FILTER1 = 数组: Exit Function '若一维数组[数组]<无变量>，不处理
If IsNull(FILTER1) Then 二维下标 = 一维下标: 二维上标 = 一维上标: 计数 = 1 Else 二维下标 = FILTER1: 二维上标 = UBound(数组, 2): 计数 = 一维上标 - 一维下标 + 1
'If IsNull(FILTER1) Then 计数 = 1 Else 计数 = 一维上标 - 一维下标 + 1
'确认[包括]
If IsObject(包括) Then
If 包括.Areas.Count > 1 Then FILTER1 = CVErr(2023): Exit Function Else 包括 = 包括.Value '采用微软做法，即当传入多个区域时，输出为#REF!
End If
If IsArray(包括) Then '[包括]是数组
变量 = Null: 变量 = LBound(包括, 2): R1 = LBound(包括, 1): C1 = UBound(包括, 1): If R1 > C1 Then FILTER1 = 包括: Exit Function '若一维数组[包括]<无变量>，不处理
If IsNull(变量) Then '[包括]一维
If R1 = C1 Then 包括 = 包括(R1): GoTo 包括为一个值
If C1 - R1 <> 二维上标 - 二维下标 Then FILTER1 = CVErr(2015): Exit Function '列数不一致
If IsNull(FILTER1) Then '[数组]一维
'ReDim 变量(1 To 二维上标 - 二维下标 + 1) As Variant
计数 = 一维下标 - 1
R1 = R1 - 1
For C1 = 一维下标 To 一维上标
R1 = R1 + 1
If IsError(包括(R1)) Then FILTER1 = 包括(R1): Exit Function Else 包括(R1) = 包括(R1) * 1
If IsNumeric(包括(R1)) Then Else FILTER1 = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括(R1) Then 计数 = 计数 + 1: 数组(计数) = 数组(C1)
Next
If 计数 <> 一维下标 - 1 Then ReDim Preserve 数组(1 To 计数 - 一维下标 + 1): FILTER1 = 数组: Exit Function Else FILTER1 = 空值: Exit Function
Else '[数组]二维
'ReDim 变量(1 To 计数, 二维上标 - 二维下标 + 1) As Variant
计数 = 二维下标 - 1
二维上标 = 计数
For R1 = R1 To C1
二维上标 = 二维上标 + 1
If IsError(包括(R1)) Then FILTER1 = 包括(R1): Exit Function Else 包括(R1) = 包括(R1) * 1
If IsNumeric(包括(R1)) Then Else FILTER1 = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括(R1) Then
计数 = 计数 + 1
For C1 = 一维下标 To 一维上标
数组(C1, 计数) = 数组(C1, 二维上标)
Next
End If
Next
If 计数 <> 二维下标 - 1 Then ReDim Preserve 数组(一维下标 To 一维上标, 1 To 计数 - 二维下标 + 1): FILTER1 = 数组: Exit Function Else FILTER1 = 空值: Exit Function
End If
Else '[包括]二维
If R1 = C1 And 变量 = UBound(包括, 2) Then 包括 = 包括(R1, 变量): GoTo 包括为一个值
If R1 = C1 Then '[包括]二维，一行
If UBound(包括, 2) - 变量 <> 二维上标 - 二维下标 Then FILTER1 = CVErr(2015): Exit Function '列数不一致
If IsNull(FILTER1) Then '[数组]一维
计数 = 一维下标 - 1
一维上标 = 一维下标 - 1
For C1 = 变量 To UBound(包括, 2)
一维上标 = 一维上标 + 1
If IsError(包括(R1, C1)) Then FILTER1 = 包括(R1, C1): Exit Function Else 包括(R1, C1) = 包括(R1, C1) * 1
If IsNumeric(包括(R1, C1)) Then Else FILTER1 = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括(R1, C1) Then 计数 = 计数 + 1: 数组(计数) = 数组(一维上标)
Next
If 计数 <> 一维下标 - 1 Then ReDim Preserve 数组(1 To 计数 - 一维下标 + 1): FILTER1 = 数组: Exit Function Else FILTER1 = 空值: Exit Function
Else '[数组]二维
计数 = 二维下标 - 1
二维上标 = 计数
For C1 = 变量 To UBound(包括, 2)
二维上标 = 二维上标 + 1
If IsError(包括(R1, C1)) Then FILTER1 = 包括(R1, C1): Exit Function Else 包括(R1, C1) = 包括(R1, C1) * 1
If IsNumeric(包括(R1, C1)) Then Else FILTER1 = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括(R1, C1) Then
计数 = 计数 + 1
For X = 一维下标 To 一维上标
数组(X, 计数) = 数组(X, 二维上标)
Next
End If
Next
If 计数 <> 二维下标 - 1 Then ReDim Preserve 数组(一维下标 To 一维上标, 1 To 计数 - 二维下标 + 1): FILTER1 = 数组: Exit Function Else FILTER1 = 空值: Exit Function
End If
ElseIf 变量 = UBound(包括, 2) Then '[包括]二维，一列
If C1 - R1 + 1 <> 计数 Then FILTER1 = CVErr(2015): Exit Function '行数不一致
'此时[数组]必定是二维，且[数组]第一维的个数（行数）>1
'确定结果数组的行数。
ReDim Preserve arr(一维下标 To 一维上标)
'交换 '赋值给已定义的变量类型，提速
计数 = 变量: 变量 = C1: C1 = 计数: 计数 = 0: X = 一维下标 - 1
For R1 = R1 To 变量 'C1
If IsError(包括(R1, C1)) Then FILTER1 = 包括(R1, C1): Exit Function Else 包括(R1, C1) = 包括(R1, C1) * 1
If IsNumeric(包括(R1, C1)) Then Else FILTER1 = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
X = X + 1: If 包括(R1, C1) Then 计数 = 计数 + 1: arr(X) = True
Next
If 计数 Then ReDim 变量(1 To 计数, 1 To 二维上标 - 二维下标 + 1) As Variant: 计数 = 0 Else FILTER1 = 空值: Exit Function
For 一维下标 = 一维下标 To 一维上标
If arr(一维下标) Then
计数 = 计数 + 1 '[变量]行数累加
X = 0 '[变量]列数初始化
For C1 = 二维下标 To 二维上标
X = X + 1: 变量(计数, X) = 数组(一维下标, C1)
Next
End If
Next
FILTER1 = 变量: Exit Function
Else
FILTER1 = CVErr(2015): Exit Function '[包括]非单行或非单列
End If
End If
Else '[包括]非数组
包括为一个值:
If 二维下标 = 二维上标 Or 计数 = 1 Then '[数组]一行或一列
If IsError(包括) Then FILTER1 = 包括: Exit Function
包括 = 包括 * 1
If IsNumeric(包括) Then Else FILTER1 = CVErr(2015): Exit Function '[包括]中的值非数值或非布尔
If 包括 Then FILTER1 = 数组: Exit Function Else FILTER1 = 空值: Exit Function
Else
FILTER1 = CVErr(2015): Exit Function
End If
End If
End Function工作表EVALUATE函数实现代码：
Function EVALUATE1(ByVal 文本公式) '函数名称连接1，是为了兼容Office与WPS。
'参数允许传入（1个字符串|1个单元格区域|1-2维数组），计算结果允许是1个字符串或一维数组或二维数组。（暂不支持输出≥3维的数组，请原谅我太懒）
On Error Resume Next
Dim 一维下标 As Long, 二维下标 As Long, 空值填充 As Variant
If IsObject(文本公式) Then '暂不采用 VarType/TypeName，这两个函数速度都慢
If 文本公式.Areas.Count > 1 Then EVALUATE1 = CVErr(2015): Exit Function Else 文本公式 = 文本公式.Value '若传入多个单元格区域，采用微软做法，输出#VALUE!
End If
If IsArray(文本公式) Then
EVALUATE1 = Null: EVALUATE1 = LBound(文本公式, 2): 空值填充 = CVErr(2015)
If IsNull(EVALUATE1) Then '一维数组
For 一维下标 = LBound(文本公式) To UBound(文本公式)
If Len(文本公式(一维下标)) Then
文本公式(一维下标) = Evaluate(文本公式(一维下标))
If IsArray(文本公式(一维下标)) Then '【若计算的是结果是数组，将数组的首个值转到2维数组】
EVALUATE1 = Null: EVALUATE1 = LBound(文本公式(一维下标), 2)
If IsNull(EVALUATE1) Then '嵌套一维数组
文本公式(一维下标) = 文本公式(一维下标)(LBound(文本公式(一维下标))) '取嵌套数组的首个值
Else '嵌套二维数组
文本公式(一维下标) = 文本公式(一维下标)(LBound(文本公式(一维下标)), EVALUATE1) '取嵌套数组的首个值
End If
End If
Else
文本公式(一维下标) = 空值填充
End If
Next
Else '二维数组
For 一维下标 = LBound(文本公式) To UBound(文本公式)
For 二维下标 = LBound(文本公式, 2) To UBound(文本公式, 2)
If Len(文本公式(一维下标, 二维下标)) Then
文本公式(一维下标, 二维下标) = Evaluate(文本公式(一维下标, 二维下标))
If IsArray(文本公式(一维下标, 二维下标)) Then '【若计算的是结果是数组，将数组的首个值转到2维数组】
EVALUATE1 = Null: EVALUATE1 = LBound(文本公式(一维下标, 二维下标), 2)
If IsNull(EVALUATE1) Then '嵌套一维数组
文本公式(一维下标, 二维下标) = 文本公式(一维下标, 二维下标)(LBound(文本公式(一维下标, 二维下标))) '取嵌套数组的首个值
Else '嵌套二维数组
文本公式(一维下标, 二维下标) = 文本公式(一维下标, 二维下标)(LBound(文本公式(一维下标, 二维下标)), EVALUATE1) '取嵌套数组的首个值
End If
End If
Else
文本公式(一维下标, 二维下标) = 空值填充
End If
Next
Next
End If
EVALUATE1 = 文本公式
Else
EVALUATE1 = Evaluate(文本公式)
End If
End Function'《转载请保留此处注释说明》
'作者: 中国-重庆-GG
'微信: cg2016-10-11
'QQ： 2939767697
'Q群： 984948500
'版本： V1.2.9
'下载： https://cg520.lanzoub.com/b01d50fza
'密码： 6666
'说明：用VBA编写了与微软工程师高度逼真的一些工作表函数，适用于全行业使用老版本Office或WPS的电脑端用户。工作表与VBA里均可调用。
'介绍：全部用法与全部输出结果与微软工程师保持98%~99%一致，使用者可以放心使用。
'兼容：兼容VBA6.0~7.1版本，兼容Windows系统下的Office和WPS几乎全部版本；MAC系统没测试（没人给我发红包买MAC）。
'用法：与自带的工作表函数用法一致。
'声明：此次分享仅供网友参考或借鉴，请勿用于任何交易，作者不承担责任。若有问题或有需求可单独联系作者以获得解决方案。
'注意：
'1、部分老版本Office或WPS在工作表中使用此自定义函数时，函数名称的前面可能显示"_xlfn."或"_xlws."等，请按"CTRL H"，将其替换掉就可以了。或者将自定义函数的名称全部替换为可被公式引擎识别的名称(不区分字母大小写)。
'2、在工作表中使用时，当参数作为动态数组传递且数组值的个数超过511/2时，可能需要先嵌套EVALUATE1函数，将其传入的值转为静态数组（WPS老版本用户需要提前嵌套）。
'3、65536行的表格与1048576行的表格不兼容，在使用自定义函数时，请尽量不要引用整行整列，可能导致计算卡顿或者参数传递丢失。
'4、xlsx或xlsm或xlam格式文件不能被Office2003或以下版本打开，xla格式与xlam格式不兼容。
'5、当多个区域传入1个参数的情况，这将在VBA代码外再套循环遍历各个区域，由于遍历对象速度总是会很慢，我偷懒没有加上遍历多区域的代码，将只取其首个区域传入参数。话又说回来，估计国内应该没什么人专门喜欢这样不按常规方式使用吧？
'6、你可以将此文件用微软Office Excel打开，然后另存为"XLA"或"XLAM"格式的加载宏文件，加载到开发工具加载项中；以便让其中的自定义函数能够在每一个打开的表格中都能使用或者发给他人使用。
8431
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
