ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 6394|回复: 43

[分享] 最值以下100个相续最值的统计

[复制链接]

TA的精华主题

TA的得分主题

发表于 2006-2-8 23:18 | 显示全部楼层 |阅读模式
问了半天,好像大伙们都没有搞过~~ 自己摸来摸去,最后搞出来了~ 最值以下100个相续最值的统计 b3wXDdth.rar (10.15 KB, 下载次数: 46)
[此贴子已经被作者于2006-2-8 23:21:42编辑过]

TA的精华主题

TA的得分主题

 楼主| 发表于 2006-2-8 23:22 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
第1大值 28
第2大值 27
第3大值 26
第4大值 17
第5大值 16
第6大值 15
第7大值 14
第8大值 13
第9大值 12
第10大值 11
第11大值 10
第12大值 9
第13大值 8

TA的精华主题

TA的得分主题

发表于 2006-2-9 08:17 | 显示全部楼层
2001全国计算机等级考试正好考了此题。

TA的精华主题

TA的得分主题

发表于 2006-2-9 08:33 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

这个循环For QQ = 0 To 99,不是很好,你这是假设最大值及向下都是连续的,不然就没有求到100个最值

较好的方法是,从大到小排序,然后循环一次,类似把不重复值取出来

如果不想用工作表排序,那就全部数据都放到数组里,排序+循环

TA的精华主题

TA的得分主题

发表于 2006-2-9 08:41 | 显示全部楼层
龙3哥好早啊,我有一个问题想请教你,我用VBA自定义函数已经弄好了,但一直想做一个Sub 宏()。但我不是很懂啊。特此请教您。 要求: 1、第1名:18 2、第2名~第16名:16,15,14,13,……,3,2 3、把每一个项目中获得名次的单位的积分累加起来,放到该单位的同一行的单元格中。 说的不是很清楚,我附上已经用VBA函数做好的例子,应该看到例子就会明白的。 GL8Rmvzx.rar (10.76 KB, 下载次数: 20)
以下是引用[I]Long_III[/I]在2006-2-9 8:33:59的发言:[BR]

这个循环For QQ = 0 To 99,不是很好,你这是假设最大值及向下都是连续的,不然就没有求到100个最值

较好的方法是,从大到小排序,然后循环一次,类似把不重复值取出来

如果不想用工作表排序,那就全部数据都放到数组里,排序+循环

TA的精华主题

TA的得分主题

发表于 2006-2-9 08:57 | 显示全部楼层

TO chenhuafu,最简单的处理就是把自定义写在过程里,如下

Private Sub CommandButton1_Click()
Dim rng As Range

Application.ScreenUpdating = False
For Each rng In Range("s3:ag26")
rng = QiuHe(Range(Cells(rng.Row, "c"), Cells(rng.Row, "r")), Cells(2, rng.Column))
Next
Application.ScreenUpdating = True
End Sub

这样处理循环会很多次,每一个单元格就需16次,循环一行就要16x16次

采用数组可以一次性循环,只是相对麻烦点,待会做一下

TA的精华主题

TA的得分主题

发表于 2006-2-9 09:13 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
谢谢龙三兄! 我不想引用QiuHe自定义函数了,只想直接在Sub 宏()里面完成。因为采用自定义函数运行比较慢。
以下是引用[I]Long_III[/I]在2006-2-9 8:57:12的发言:

TO chenhuafu,最简单的处理就是把自定义写在过程里,如下

Private Sub CommandButton1_Click()
Dim rng As Range

Application.ScreenUpdating = False
For Each rng In Range("s3:ag26")
rng = QiuHe(Range(Cells(rng.Row, "c"), Cells(rng.Row, "r")), Cells(2, rng.Column))
Next
Application.ScreenUpdating = True
End Sub

这样处理循环会很多次,每一个单元格就需16次,循环一行就要16x16次

采用数组可以一次性循环,只是相对麻烦点,待会做一下

[此贴子已经被作者于2006-2-9 9:17:12编辑过]

TA的精华主题

TA的得分主题

发表于 2006-2-9 09:26 | 显示全部楼层

简单点处理吧,如果还想提速,就得用数组来做

Sub hjs()
Dim rng As Range, c As Range
Dim a%

Application.ScreenUpdating = False
Cells.Replace " ", "", lookat:=xlPart '你的数据里有些含有空格,所以有些不能直接查找对应,这句把空格替换成空
Range("s3:ag26").ClearContents
For Each rng In Range("c3:r26")
If rng <> "" Then
a = IIf(rng.Column = 3, 18, 20 - rng.Column) '计算单元格对应的分数,根据列数来求
Set c = Range("s2:ag2").Find(rng, lookat:=xlWhole)
If Not c Is Nothing Then
Cells(rng.Row, c.Column) = Cells(rng.Row, c.Column) + a
End If
End If
Next
Application.ScreenUpdating = True
End Sub

TA的精华主题

TA的得分主题

发表于 2006-2-9 10:05 | 显示全部楼层
再次感谢龙兄!
以下是引用[I]Long_III[/I]在2006-2-9 9:26:33的发言:[BR]

简单点处理吧,如果还想提速,就得用数组来做

Sub hjs()
Dim rng As Range, c As Range
Dim a%

Application.ScreenUpdating = False
Cells.Replace " ", "", lookat:=xlPart '你的数据里有些含有空格,所以有些不能直接查找对应,这句把空格替换成空
Range("s3:ag26").ClearContents
For Each rng In Range("c3:r26")
If rng <> "" Then
a = IIf(rng.Column = 3, 18, 20 - rng.Column) '计算单元格对应的分数,根据列数来求
Set c = Range("s2:ag2").Find(rng, lookat:=xlWhole)
If Not c Is Nothing Then
Cells(rng.Row, c.Column) = Cells(rng.Row, c.Column) + a
End If
End If
Next
Application.ScreenUpdating = True
End Sub

TA的精华主题

TA的得分主题

发表于 2006-2-9 10:29 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册

全部显示

Find 方法

参阅应用于示例特性

应用于 WorksheetFunction 对象的 Find 方法。

在工作表中查找特定信息。

expression.Find(Arg1, Arg2, Arg3)

expression 必需。该表达式返回一个 WorksheetFunction 对象。

Arg1 String 类型,必需。工作表名称。

Arg2 String 类型,必需。单元格区域名称。

Arg3 Variant 类型,可选。精确限制查询的参数名称。

应用于 Range 对象的 Find 方法。

在区域中查找特定信息,并返回 Range 对象,该对象代表用于查找信息的第一个单元格。如果未发现匹配单元格,就返回 Nothing。本方法不影响选定区域或活动单元格。

有关在 Visual Basic 中使用 Find 工作表函数的详细信息,请参阅在 Visual Basic 中使用工作表函数

expression.Find(What, After, LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SerchFormat)

expression 必需。该表达式返回一个 Range 对象。

What Variant 类型,必需。要搜索的数据。可为字符串或任意 Microsoft Excel 数据类型。

After Variant 类型,可选。表示搜索过程将从其之后开始进行的单元格。此单元格对应于从用户界面搜索时的活动单元格位置。值得注意的是,After 必须是区域中的单个单元格。请记住搜索是从该单元格之后 开始的;直到本方法绕回到指定的单元格时,才对其进行搜索。如果未指定本参数,搜索将从区域的左上角单元格之后开始。

LookIn Variant 类型,可选。信息类型。

LookAt Variant 类型,可选。可为以下 XlLookAt 常量之一:xlWholexlPart

SearchOrder Variant 类型,可选。可为以下 XlSearchOrder 常量之一:xlByRowsxlByColumns

SearchDirection XlSearchDirection 类型,可选。搜索的方向。

XlSearchDirection 可为以下 XlSearchDirection 常量之一。
xlNext 默认值
xlPrevious

MatchCase Variant 类型,可选。若为 True,则进行区分大小写的查找。默认值为 False

MatchByte Variant 类型,可选。仅在选择或安装了双字节语言支持时使用。若为 True,则双字节字符仅匹配双字节字符。若为 False,则双字节字符可匹配其等价的单字节字符。

SearchFormat Variant 类型,可选。搜索的格式。

说明

每次使用本方法后,参数 LookInLookAtSearchOrderMatchByte 的设置将保存。如果下次调用本方法时不指定这些参数的值,就使用保存的值。设置这些参数将更改“查找和替换”对话框中的设置,如果您忽略参数,更改“查找和替换”对话框中的设置将更改使用的保存值。若要避免这种问题的出现,每次使用该方法时请明确设置这些参数。

可以使用 FindNextFindPrevious 方法重复搜索。

当搜索到指定的搜索区域的末尾时,本方法将绕回到区域的开始继续搜索。发生绕转后,若要停止搜索,请保存第一个找到的单元格地址,然后依据该保存地址测试每个后续查找到的单元格地址。

若要进行更为复杂的模式匹配查找,请用 For Each...Next 语句和 Like 运算符。例如,下列代码在单元格区域 A1:C5 中搜索字体名称以“Cour”开始的单元格。当 Microsoft Excel 找到匹配单元格以后,就将其字体改为“Times New Roman”。

For Each c In [A1:C5]
    If c.Font.Name Like "Cour*" Then
        c.Font.Name = "Times New Roman"
    End If
Next
				

示例

本示例在工作表的单元格区域 A1:A500 中查找包含值 2 的所有单元格,并将这些单元格的值更改为 5。

With Worksheets(1).Range("a1:a500")
    Set c = .Find(2, lookin:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = 5
            Set c = .FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If
End With
		
  1. &lt;SCRIPT language=JScript src="mk:@msitstore:msohlp11.chm::/html/ofvbanl.js" type=text/javascript&gt;<br><br>&lt;/script&gt;
复制代码
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

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

GMT+8, 2024-5-4 02:26 , Processed in 0.043194 second(s), 12 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

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

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

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