按指定条件、指定序号忽略空格提取对应数据的自定义函数

WYS67 · 发表于 2020-1-14 12:56

yjh_27 发表于 2020-1-14 12:51
目前各参数是按单列处理，输出也是按单列处理。

如参数、输出都是单列或单行，找到识别能做到。

怎样才能使公式忽略数据源的行、列区分，无论在列区域，还是行区域输入数组公式，都能显示正确结果？

WYS67 · 发表于 2020-1-14 13:22

怎样才能使公式忽略数据源的行、列区分，无论在列区域，还是行区域输入数组公式，都能显示正确结果？

WYS67 · 发表于 2020-1-14 14:33

使公式能够忽略数据源的行、列区分，无论在列区域，还是行区域输入数组公式，都能显示正确结果？

WYS67 · 发表于 2020-1-14 16:57

怎样才能使公式忽略数据源的行、列区分，无论在列区域，还是行区域输入数组公式，都能显示正确结果？

lsdongjh · 发表于 2020-1-14 17:03

Option Explicit
Function ZDXHTQ(rgFind As Range, varFind As Variant, rgData As Range, varID As Variant) As Variant
Dim arrFind As Variant, arrData As Variant, arrID As Variant, arrReturn As Variant
Dim arrTemp As Variant, strTemp As String, strFind As String
Dim rgTemp As Range, lngRows As Long, lngCols As Long
Dim lngMaxID As Long, lngRid As Long, lngCid As Long
Dim lngMin As Long, lngMax As Long, lngTemp As Long
Dim intFindRowOrCol As Integer '条件区域为行还是列， 0 为列，1为行
Dim intDataRowOrCol As Integer '数据区域为行还是列， 0 为列，1为行
Dim intReturnRowOrCol As Integer '返回区域为行还是列， 0 为列，1为行
'判断公式所在区域的设置
'-------------------------------------------------------
Set rgTemp = Application.Caller
lngRows = rgTemp.Rows.Count
lngCols = rgTemp.Columns.Count
ReDim arrReturn(1 To lngRows, 1 To lngCols) As String
Set rgTemp = Nothing
If lngRows <> 1 And lngCols <> 1 Then
arrReturn(1, 1) = "公式区域有误！"
ZDXHTQ = arrReturn
Exit Function
End If
'列优先
If lngRows = 1 Then
intReturnRowOrCol = 1
End If
If lngCols = 1 Then
intReturnRowOrCol = 0
End If
'判断条件区域的设置
'-------------------------------------------------------
arrFind = rgFind
lngRows = rgFind.Rows.Count
lngCols = rgFind.Columns.Count
If lngRows <> 1 And lngCols <> 1 Then
arrReturn(1, 1) = "条件区域有误！"
ZDXHTQ = arrReturn
Exit Function
End If
'列优先
If lngRows = 1 Then intFindRowOrCol = 1
If lngCols = 1 Then intFindRowOrCol = 0
'判断查找值
'-------------------------------------------------------
If IsArray(varFind) Then
arrReturn(1, 1) = "查找值有误！"
ZDXHTQ = arrReturn
Exit Function
End If
strFind = Trim(varFind)
If strFind = "" Then
arrReturn(1, 1) = "查找值有误！"
ZDXHTQ = arrReturn
Exit Function
End If
'判断数据区域的设置
'-------------------------------------------------------
arrData = rgData
lngRows = rgData.Rows.Count
lngCols = rgData.Columns.Count
If lngRows <> 1 And lngCols <> 1 Then
arrReturn(1, 1) = "数据区域有误！"
ZDXHTQ = arrReturn
Exit Function
End If
'列优先
If lngRows = 1 Then intDataRowOrCol = 1
If lngCols = 1 Then intDataRowOrCol = 0
'比对条件区域与数据区域，以最小行列数为循环终止数
'-------------------------------------------------------
If intDataRowOrCol = 1 Then
lngMaxID = UBound(arrData, 2)
Else
lngMaxID = UBound(arrData)
End If
If intFindRowOrCol = 1 Then
If lngMaxID > UBound(arrFind, 2) Then lngMaxID = UBound(arrFind, 2)
Else
If UBound(arrFind, 2) > UBound(arrFind) Then lngMaxID = UBound(arrFind)
End If
'序号处理
'-------------------------------------------------------
arrTemp = varID
If IsArray(varID) Then
'如果是数组
On Error Resume Next '出错处理
lngRows = UBound(arrTemp)
lngCols = 0: lngCols = UBound(arrTemp, 2)
Select Case lngCols
Case 0 '一维
arrID = arrTemp
Case 1 '二维一列
ReDim arrID(1 To lngRows) As String
For lngRid = 1 To lngRows
arrID(lngRid) = arrTemp(lngRid, 1)
Next
Case Is > 1
If lngRows <> 1 Then
arrReturn(1, 1) = "序号区域有误！"
ZDXHTQ = arrReturn
Exit Function
Else
ReDim arrID(1 To lngCols) As String
For lngCid = 1 To lngCols
arrID(lngCid) = arrTemp(1, lngCid)
Next
End If
End Select
Else
'不是数组,判断是不是有冒号
If InStr(arrTemp, ":") > 0 Then
arrTemp = Split(arrTemp, ":")
lngMin = Val(arrTemp(0))
lngMax = Val(arrTemp(1))
lngTemp = Abs(lngMax - lngMin) + 1
ReDim arrID(1 To lngTemp) As String
lngTemp = 1
If lngMin < lngMax Then
For lngRid = lngMin To lngMax
arrID(lngTemp) = lngRid
lngTemp = lngTemp + 1
Next
Else
For lngRid = lngMin To lngMax Step -1
arrID(lngTemp) = lngRid
lngTemp = lngTemp + 1
Next
End If
Else
'没有，返回唯一值
ReDim arrID(1 To 1) As String
arrID(1) = Val(arrTemp)
End If
End If
'判断序号数量与公式所在区域是否匹配
'-------------------------------------------------------
If intReturnRowOrCol = 1 Then
lngCid = UBound(arrReturn, 2)
Else
lngCid = UBound(arrReturn)
End If
If lngCid < UBound(arrID) Then
arrReturn(1, 1) = "公式区域小于序列数量！"
ZDXHTQ = arrReturn
Exit Function
End If
'查找运算
'-------------------------------------------------------
ReDim arrTemp(1 To lngMaxID): lngTemp = 1
Select Case intFindRowOrCol
Case 1
For lngCid = LBound(arrFind, 2) To lngMaxID
If arrFind(1, lngCid) = strFind Then
If intDataRowOrCol = 1 Then
If arrData(1, lngCid) <> "" Then arrTemp(lngTemp) = arrData(1, lngCid): lngTemp = lngTemp + 1
ElseIf intDataRowOrCol = 0 Then
If arrData(lngCid, 1) <> "" Then arrTemp(lngTemp) = arrData(lngCid, 1): lngTemp = lngTemp + 1
End If
End If
Next
lngMaxID = lngTemp
Case 0
For lngRid = LBound(arrFind) To lngMaxID
If arrFind(lngRid, 1) = strFind Then
If intDataRowOrCol = 1 Then
If arrData(1, lngRid) <> "" Then arrTemp(lngTemp) = arrData(1, lngRid): lngTemp = lngTemp + 1
ElseIf intDataRowOrCol = 0 Then
If arrData(lngRid, 1) <> "" Then arrTemp(lngTemp) = arrData(lngRid, 1): lngTemp = lngTemp + 1
End If
End If
Next
lngMaxID = lngTemp
End Select
'根据序号提取值
'-------------------------------------------------------
For lngRid = LBound(arrID) To UBound(arrID)
lngTemp = (lngMaxID + Val(arrID(lngRid))) Mod lngMaxID
arrID(lngRid) = arrTemp(lngTemp)
Next
'根据公式区域形式返回行或列
'-------------------------------------------------------
For lngRid = LBound(arrID) To UBound(arrID)
If intReturnRowOrCol = 1 Then
arrReturn(1, lngRid) = arrID(lngRid)
Else
arrReturn(lngRid, 1) = arrID(lngRid)
End If
Next
'返回值
'-------------------------------------------------------
ZDXHTQ = arrReturn
End Function

复制代码

WYS67 · 发表于 2020-1-14 17:31

lsdongjh 发表于 2020-1-14 17:03

经反复测试，老师编写的代码都能显示正确的结果，非常感谢老师！！！

祝老师新年快乐！

lss001 · 发表于 2020-1-14 19:47

本帖最后由 lss001 于 2020-1-17 12:52 编辑

WYS67 发表于 2020-1-14 14:33
使公式能够忽略数据源的行、列区分，无论在列区域，还是行区域输入数组公式，都能显示正确结果？

提取对应数据.rar (73.07 KB, 下载次数: 3)

WYS67 · 发表于 2020-1-14 21:10

lss001 发表于 2020-1-14 19:47

感谢老师！祝老师新年快乐！

提取对应数据.zip (206.19 KB, 下载次数: 1)

如果能够实现15楼代码具备的功能【见上面截图H4:AA11的计算结果】就更加完美和强大了！

1.当采取区域数组公式输入时，第四参数既可以用C5:C22的单元格指定，也可以直接输入带起止标志的连续序号范围【如"1:18"，代表符合指定条件的、自上而下的第1~18个数据，"18:1"则是代表符合指定条件的、自上而下的第18~1个数据；而"-1:-18"代表符合指定条件的、自下而上的的第1~18个数据，"-18:-1"代表符合指定条件的、自下而上的的第18~1个数据】
2.公式忽略数据源的行、列区域差异，无论在列区域，还是行区域输入数组公式，都能显示正确结果。

lss001 · 发表于 2020-1-14 23:36

WYS67 发表于 2020-1-14 21:10
感谢老师！祝老师新年快乐！

参考楼上更新附件。。。

WYS67 · 发表于 2020-1-15 02:34

lss001 发表于 2020-1-14 23:36
参考楼上更新附件。。。

提取对应数据 (2).zip (198.51 KB, 下载次数: 3)

很好，很强大！

不知为什么，第四参数调用单元格指定时，D5:D22【列区域输入】可以显示查询结果，而J5:AA5【行区域输入】除J5外，K5:AA5怎么显示空白？K9:AA9也显示空白？
选定J5:AA5，输入区域数组公式 { =ZDXHTQ($A$5:$A$100000,$J$3,$B$5:$B$100000,J4:AA4) ；
选定J9:AA9,输入区域数组公式 { =ZDXHTQ($A$5:$A$100000,$J$3,$B$5:$B$100000,J8:AA8) 。

按说第二、第四参数都是既可以直接输入指定条件和序号，也可以调用单元格指定：J5:AA5应该与J6:AA6显示同样的结果，J9:AA9应该与J10:AA10显示同样的结果才对。

		自动登录	找回密码
密码			免费注册

[已解决] 按指定条件、指定序号忽略空格提取对应数据的自定义函数

评分

评分

评分

浏览过的版块