网站首页 > 资源文章 正文
任务要求:
Excel高手用VBA解决最大数字连续次数,用VBA统计E列中1出现最大连续次数,结果保存H20,用按钮控制结果。
Sub tes3t()
For Each x In Range("e5:e" & [e65536].End(3).Row)
If x = 1 Then
n = n + 1
If k < n Then k = n
Else
n = 0
End If
Next
[H22] = k
End Sub
以上代码用sub方式制作,可以完成求1的最大次数。如果单元格中x=1,则累加n+1,并比较K值,如果此时n比k大,则k=n.刷新了最大值。
但其中1是个定值,不方便扩展。如果要求2的最大连续是还要改。
下面我制作一个非常通用的vba自定义函数,来解决这个问题。
Function maxcs(rng As Range, 要查找的值 As Integer) As Integer
Dim arr, i, n
Dim k As Integer
k = 0
arr = rng.Value
For i = 1 To UBound(arr, 1)
If arr(i, 1) = 要查找的值 Then
n = n + 1
If k < n Then k = n
Else
n = 0
End If
Next
maxcs = k
End Function
主体代码几乎完全一样,只是为了程序健壮性,加了dim声明,并且提供了"要查找的值"作为参数
用以下代码测试下:
Sub test01()
Dim rng As Range
Set rng = Sheets(1).Range("E5:E19")
MsgBox CStr(maxcs(rng, 1))
End Sub
可以正确返回1的最大连续次数5.
在excel表格用公式方法测试:
公式简单明了,普通用户也可以用。比excel公式高手编写的长串公式简明多了。参数变化问题也解决了。
最后一步:收集到vbnet库中
Function max连续次数(arr(,) As Object, 要查找的值 As Object) As Integer
Dim i, j, n, k As Integer
n = 0 : k = 0
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
If arr(i, j) = 要查找的值 Then
n = n + 1
If k < n Then k = n
Else
n = 0
End If
Next
Next
Return k
End Function
结论:
vba方法适用于sub过程 和function函数,可以完美解决自定义公式的复杂参数问题。
以上方法也可以方便移植到vbnet,一码三用。完全不用重写三遍了。这就是上文我说的vbnet代码兼容vb和vb6。
猜你喜欢
- 2025-01-04 如何零基础学习VBA—HtmlFile和HtmlProjectItems对象
- 2025-01-04 solid works中参数化到底是个什么鬼?
- 2025-01-04 一个VB写的色环电阻计算器
- 2025-01-04 C#工控上位机系列(2)- 串口通信/监控工具
- 2025-01-04 谁懂?!原来维生素的测定可以这么简单!
- 2025-01-04 从0开始学编程,包装产品报价软件终于出炉
- 2025-01-04 Python又称胶水语言,那如何通过Python使用DLL / COM对象?
- 2025-01-04 VBA|比较怪异的一些语法规则
- 2025-01-04 FlexGrid 功能演示 Demo 上线啦!
- 2025-01-04 药片上的压印缩写啥意思?
你 发表评论:
欢迎- 最近发表
- 标签列表
-
- 电脑显示器花屏 (79)
- 403 forbidden (65)
- linux怎么查看系统版本 (54)
- 补码运算 (63)
- 缓存服务器 (61)
- 定时重启 (59)
- plsql developer (73)
- 对话框打开时命令无法执行 (61)
- excel数据透视表 (72)
- oracle认证 (56)
- 网页不能复制 (84)
- photoshop外挂滤镜 (58)
- 网页无法复制粘贴 (55)
- vmware workstation 7 1 3 (78)
- jdk 64位下载 (65)
- phpstudy 2013 (66)
- 卡通形象生成 (55)
- psd模板免费下载 (67)
- shift (58)
- localhost打不开 (58)
- 检测代理服务器设置 (55)
- frequency (66)
- indesign教程 (55)
- 运行命令大全 (61)
- ping exe (64)
本文暂时没有评论,来添加一个吧(●'◡'●)