ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
EH云课堂-专业的职场技能充电站 限时送,魔方网表将Excel变在线系统 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 ExcelHome出品 - VBA代码宝免费下载 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
楼主: WYS67

[求助] 根据表一的代码,增加序号区域参数,创建适用于表二计数统计的自定义函数

[复制链接]

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-12 15:04 | 显示全部楼层
跪求擅长编写自定义函数代码的老师们施以援手!

TA的精华主题

TA的得分主题

发表于 2019-2-12 15:35 | 显示全部楼层
  1. Public Function XHCOUNTIF(QY As Range, ZQ, tj, ey As Range, Optional x = 0)
  2.     Application.Volatile
  3.     arr = QY
  4.     crr = ey
  5.     For s = UBound(crr) To 1 Step -1
  6.         If crr(s, 1) <> "" Then Exit For
  7.     Next
  8.     ReDim brr(1 To s, 1 To 1) As Variant
  9.     For i = 1 To s
  10.         brr(i, 1) = ""
  11.     Next
  12.     n = 1

  13.     m = crr(1, 1) + ZQ - 1
  14.     For i = 1 To s
  15.         If m <= crr(s, 1) Then
  16.             For j = n To s
  17.                 If crr(j, 1) > m Then
  18.                     n = j
  19.                     m = m + ZQ
  20.                     Exit For
  21.                 Else
  22.                     If Val(tj) = Val(arr(j, 1)) Then
  23.                         brr(i, 1) = Val(brr(i, 1)) + 1
  24.                     End If
  25.                 End If
  26.             Next j
  27.         Else
  28.             For j = n To UBound(crr)
  29.                 If Len(crr(j, 1)) > 0 Then
  30.                     If tj = arr(j, 1) Then
  31.                         brr(i, 1) = Val(brr(i, 1)) + 1
  32.                     End If
  33.                 End If
  34.             Next j
  35.             If x = 0 Then
  36.                 brr(i, 1) = ""
  37.             End If
  38.             Exit For
  39.         End If
  40.     Next

  41.     XHCOUNTIF = brr
  42. End Function
复制代码

评分

参与人数 1鲜花 +2 收起 理由
WYS67 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

发表于 2019-2-12 15:36 | 显示全部楼层
附件的自定义公式供参考,k列有公式

修改代码,拓展表一的计算功能.zip

653.93 KB, 下载次数: 2

评分

参与人数 1鲜花 +2 收起 理由
WYS67 + 2 太强大了

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-12 16:26 | 显示全部楼层
liulang0808 发表于 2019-2-12 15:36
附件的自定义公式供参考,k列有公式

123.gif

版主老师:您写的代码很强大!基本上实现了我的心中所想。1.正如上面截图所示,当序号和数据区域E2008以下因没有数据而显示为空时,公式结果输出列K2008:M10000的#N/A错误,也必须显示为空白!!!这样才能对K:M列的结果进行二次统计;2.区域数组公式里参数先后顺序修改为: {  =XHCOUNTIF(数据区域,指定间隔序号,满额与不满额周期选择,指定数据,序号区域)序号区域作为第五参数放在最后,当省略序号区域参数时,默认序号区域在E列】,如:在K5:K10000里输入  {  =XHCOUNTIF($G$5:$G$100000,$M$1,$M$2,K$4,$E$5:$E$100000) 或者=XHCOUNTIF($G$5:$G$100000,$M$1,$M$2,K$4)省略序号区域,默认为E】 ,这样更清楚明了!因为绝大多数情况下,序号都存放在E列,所以省略最后参数后--序号区域默认在E列!  除非序号区域不在E列的特殊情况下,才会在公式里明确输入最后那个参数--序号区域

  如能完善上面2处的代码,那自定义函数XHCOUNTIF就真的十全十美了!

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-12 16:28 | 显示全部楼层

版主老师:恳请您按14楼描述修改代码。再次相烦了。

TA的精华主题

TA的得分主题

发表于 2019-2-12 16:28 | 显示全部楼层
ReDim brr(1 To s, 1 To 1) As Variant
这个地方做了数组上届的限制
因为超过s以后,肯定没有意义的
所以楼主的出现错误
按照楼主的要求,可以修改为
ReDim brr(1 To ubound(crr), 1 To 1) As Variant
这样看看吧

评分

参与人数 1鲜花 +2 收起 理由
WYS67 + 2 感谢帮助

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-12 16:42 | 显示全部楼层
本帖最后由 WYS67 于 2019-2-12 16:50 编辑
liulang0808 发表于 2019-2-12 16:28
ReDim brr(1 To s, 1 To 1) As Variant
这个地方做了数组上届的限制
因为超过s以后,肯定没有意义的

老师:把ReDim brr(1 To s, 1 To 1) As Variant  修改为ReDim brr(1 To ubound(crr), 1 To 1) As Variant  后,原先显示的#N/A全部变成了“0”,这个仍然不符合要求,难道不能屏蔽为空白吗?
还有,我原先公式里的参数先后顺序有点混乱,能否按14楼2的要求,修改成 =XHCOUNTIF(数据区域,指定间隔序号,满额与不满额周期选择,指定数据,序号区域) 的顺序排列?并且当第五参数省略时,默认序号区域为E列?如选定K5:K10000,输入区域数组公式{  =XHCOUNTIF($G$5:$G$100000,$M$1,$M$2,K$4)【省略序号区域,默认为E】 也能显示正确结果,而不是#VALUE!错误?

TA的精华主题

TA的得分主题

发表于 2019-2-12 16:44 | 显示全部楼层
WYS67 发表于 2019-2-12 16:42
老师:把ReDim brr(1 To s, 1 To 1) As Variant  修改为ReDim brr(1 To ubound(crr), 1 To 1) As Variant ...

不好意思,还有地方需要同步修改的
ReDim brr(1 To s, 1 To 1) As Variant
    For i = 1 To s
        brr(i, 1) = ""
    Next
上面的s都要修改的ubound(crr)的

评分

参与人数 1鲜花 +2 收起 理由
WYS67 + 2

查看全部评分

TA的精华主题

TA的得分主题

 楼主| 发表于 2019-2-12 16:53 | 显示全部楼层
liulang0808 发表于 2019-2-12 16:44
不好意思,还有地方需要同步修改的
ReDim brr(1 To s, 1 To 1) As Variant
    For i = 1 To s

恳请版主老师按14楼和17楼的补充意见完善代码后,一并上传附件。

TA的精华主题

TA的得分主题

发表于 2019-2-12 16:56 | 显示全部楼层
WYS67 发表于 2019-2-12 16:53
恳请版主老师按14楼和17楼的补充意见完善代码后,一并上传附件。

自定义函数要调用表格区域,最好才参数中赋值,不要放到函数里,不然有可能出现不可预见的问题

评分

参与人数 1鲜花 +2 收起 理由
WYS67 + 2 感谢帮助

查看全部评分

您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-2-20 07:40 , Processed in 0.093898 second(s), 21 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表