创建 多条件查询的自定义函数

WYS67

lss001 发表于 2018-11-18 22:23
请重新下载33楼附件！

无比地强大！再谢老师！

WYS67

lss001 发表于 2018-11-17 20:14
请重新下载附件！

老师：33楼附件里的自定义函数计算功能很强大！但由于参数过多，导致数据量过大时运算速度慢，并且有点卡，正好用在年度月底的统计上！

  平时用上面截图所示的这个简化后的自定义函数就足已处理绝大多数数据了！恳请老师根据里面的说明和要求，编写自定义函数YILOUQY的代码。

遗漏分区和剩余期数.zip (33.82 KB, 下载次数: 5)

2018-12-10 20:13 上传

点击文件名下载附件

lss001

在第二行加上→
Application.EnableEvents = False
在倒数第二行加上→
Application.EnableEvents = True
以加快速度！其它函数也可以加上！

WYS67

lss001 发表于 2018-12-10 21:14
在第二行加上→
Application.EnableEvents = False
在倒数第二行加上→

老师：原来的第二行 'Application.Volatile变成第三行？

WYS67

lss001 发表于 2018-12-10 21:14
在第二行加上→
Application.EnableEvents = False
在倒数第二行加上→

恳请您按53楼缩减了非必须参数的附件，编写一个新的简洁明快的自定义函数。

lss001

WYS67 发表于 2018-12-10 21:35
恳请您按53楼缩减了非必须参数的附件，编写一个新的简洁明快的自定义函数。

精简函数以前已经有了，33楼才是后来改进增加参数！？

WYS67

lss001 发表于 2018-11-17 20:14
请重新下载附件！

老师：我又在http://club.excelhome.net/thread-1450840-1-1.html发帖求助，但正如6楼abc123281老师所说，看不懂里面的逻辑关系；而您曾经写过类似的代码，驾轻就熟，还请老师成全我的愿望，写个代码。学生叩首拜求老师了。

WYS67

lss001 发表于 2018-9-23 22:08
→_→→_→

老师：新年好！好久不见。由于急需以间隔序号为周期进行多种统计的自定义函数，本人愚笨，需要在论坛里求助，但里面有好多运算规则，很难描述准确和清楚，只得晒出您写的自定义函数“以指定间隔数据个数为周期进行多种统计”作为蓝本和范例，还请老师宽恕。
   顺祝老师猪年吉祥如意，兴旺发达！

WYS67

lss001 发表于 2018-11-17 20:14
请重新下载附件！

老师：真是不好意思，还得麻烦您给33楼的代码增加一个判断语句：表二《有问题》E F G列粉红色填充所示：D列是第五参数指定次序，E列公式 {   =DTJCX($A$5:$A$100000,$E$3,$B$5:$B$100000,E$4,$D5:$D40)   计算出的符合条件的数据个数如辅助列C列所示，只有29个，小于第五参数指定次序$D5:$D40的36个，所以就会出现粉红色填充显示的错误结果【如果符合条件的数据个数，等于或大于$D5:$D40的36个则可以显示正确结果】。
正确的结果是：1.F5:F33显示如G5:G33；2.而E34:G40由于已没有符合条件的数据，则应该显示为空白！



总是无法上传附件，代码如下：

Function DTJCX(aa As Range, a, ab As Range, b, ac As Range, Optional u, Optional v = "")
'Application.Volatile
Dim ar, br, cr, dr, er, fr, gr, hr, rr, R, s, t, i&, j&, k&, n&
    ar = aa: br = ab: cr = ac: s = a: t = b
    ReDim dr(1 To UBound(ar), 0), er(1 To UBound(ar), 0), fr(1 To UBound(ar), 0)
    For k = UBound(ar) To 1 Step -1
        If ar(k, 1) <> "" Then Exit For
    Next
    For i = 1 To k
        If ar(i, 1) <> "" And br(i, 1) <> "" And ar(i, 1) = s Then
            n = n + 1: dr(n, 0) = br(i, 1)
        End If
    Next
    If IsArray(cr) Then
        If t = 0 Then
            For i = 1 To UBound(ar)
                If cr(1, 1) < cr(UBound(cr), 1) Then y = i Else y = UBound(cr) - i + 1
                If i <= UBound(cr) Then er(i, 0) = dr(y, 0) Else er(i, 0) = ""
            Next
        Else
            For i = 1 To UBound(ar)
                If cr(1, 1) < cr(UBound(cr), 1) Then y = i Else y = UBound(cr) - i + 1
                If i <= UBound(cr) Then er(i, 0) = dr(n - y + 1, 0) Else er(i, 0) = ""
            Next
        End If
    Else
        If t = 0 Then R = dr(cr, 0) Else R = dr(n - cr + 1, 0)
        If cr = "" Then R = ""
    End If
    If v = "" Then
        If IsArray(cr) Then DTJCX = er Else DTJCX = R
    Else
        hr = u: ReDim gr(0 To UBound(hr)): gr(0) = 0
        For i = 1 To UBound(hr): gr(i) = hr(i, 1): Next
        If IsArray(cr) Then
            For i = 1 To UBound(ar)
                If i <= UBound(cr) Then
                    For j = UBound(gr) To 1 Step -1
                        If er(i, 0) > gr(j - 1) And er(i, 0) <= gr(j) Then
                            If v = 1 Then fr(i, 0) = j - 1 Else fr(i, 0) = gr(j) - er(i, 0)
                        End If
                    Next
                Else
                    fr(i, 0) = ""
                End If
            Next
            DTJCX = fr
        Else
            If R = "" Then
                rr = ""
            Else
                For j = UBound(gr) To 1 Step -1
                    If R > gr(j - 1) And R <= gr(j) Then
                        If v = 1 Then rr = j - 1 Else rr = gr(j) - R
                    End If
                Next
            End If
            DTJCX = rr
        End If
    End If
End Function

WYS67

lss001 发表于 2018-11-17 20:14
请重新下载附件！

论坛咋了，老是不能上传附件！