|
|
楼主 |
发表于 2020-1-24 01:22
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
本帖最后由 WYS67 于 2020-1-25 15:41 编辑
按指定条件、指定序号忽略空格提取对应数据.zip
(168.67 KB, 下载次数: 4)
老师：全怪我粗心大意，没有交代清楚，使得您15楼编写的代码，少了一个判断-- 公式 =ZDXHTQ(条件区域,指定条件,数据区域,指定序号区域或指定序号)，当符合指定条件的数据个数，少于第四参数指定的序号区域或指定序号时，其结果应该显示空白！
如上面截图黄色填充区域【工作表《验证》】的A:B列所示，数据源sheet1的数据区域B5:B100000里，符合指定条件3的非空数据只有640个，所以当第四参数指定序号区域或指定序号超出640的，应该全部显示空白！即工作表《验证》的计算结果 E645:E1000，H5:H360,K645:K1000,N5:N360都应该显示空白才对。
麻烦老师修改相关代码，使得：当符合指定条件的数据个数，少于第四参数指定的序号区域或指定序号时，其结果应该显示空白！ 不胜感谢之至！
需要修改的15楼代码如下：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
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2020-1-20 19:46
