设为首页收藏本站

开启辅助访问

Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 如何快速求出这个最大值？

数据透视表40+个常用小技巧，让你一次学会！

发新帖

查看: 1832|回复: 6

[已解决]如何快速求出这个最大值？

发表于 2016-5-6 16:28 | 显示全部楼层 |阅读模式

工作中常用的Excel函数公式，全印在一张超大鼠标垫上

请教各位高手，要求在附件中。

最佳答案

月排行榜 / 总排行榜

dsmch

2016-5-11 22:52

Sub Macro1()
Dim arr, brr, w, d, i&, j%, k%
Set d = CreateObject("scripting.dictionary")
arr = Range("a2").CurrentRegion
n = UBound(arr)
ReDim brr(1 To n, 1 To 10)
For i = 1 To n
s = 0
For j = 1 To 4
For k = j + 1 To 5
s = s + 1
brr(i, s) = Val(Mid(arr(i, 3), j, 1) & Mid(arr(i, 3), k, 1))
Next
Next
Next
For j = 1 To 10
ReDim w(99)
For i = 1 To n
w(brr(i, j)) = n - 1 - i
d(w(brr(i, j))) = brr(i, j)
Next
Cells(1001, j + 22) = Application.Max(w)
Cells(1003, j + 22) = d(Application.Max(w))
d.RemoveAll
Next
End Sub

复制代码

跳转到最佳答案楼层

最大值, 如何

数据--002.zip

44.82 KB, 下载次数: 24

相关帖子

回复

使用道具举报

工作中最常用的函数公式，全印在一张超大的鼠标垫上

发表于 2016-5-7 23:28 | 显示全部楼层

工作中常用的Excel函数公式，全印在一张超大鼠标垫上

Sub Macro1()
Dim arr, brr, w, i&, j%, k%
arr = Range("a2").CurrentRegion
n = UBound(arr)
ReDim brr(1 To n, 1 To 10)
For i = 1 To n
s = 0
For j = 1 To 4
For k = j + 1 To 5
s = s + 1
brr(i, s) = Val(Mid(arr(i, 3), j, 1) & Mid(arr(i, 3), k, 1))
Next
Next
Next
For j = 1 To 10
ReDim w(99)
For i = 1 To n
w(brr(i, j)) = n + 1 - i
Next
Cells(1001, j + 22) = Application.Max(w)
Next
End Sub

复制代码

评分

参与人数 1	+1	收起理由
hua221	+ 1	很给力

查看全部评分

回复

使用道具举报

楼主| 发表于 2016-5-9 19:33 | 显示全部楼层

工作中最常用的Excel函数公式，全印在一张鼠标垫上

万分感谢dsmch老师的帮助，代码太棒了！！！

回复

使用道具举报

楼主| 发表于 2016-5-10 23:14 | 显示全部楼层

哪位大神能将 Max(w) 对应的数字也同时写入Cells(1003, j + 22) = Application.Max(w)就更好了！

点评

对应什么数字？用附件说明问题发表于 2016-5-10 23:19

回复

使用道具举报

楼主| 发表于 2016-5-10 23:32 | 显示全部楼层

dsmch高手请看附件，里边有代码。就是要那哪行数字。我觉得你这段代码更好些。请帮忙用你的代码达到表中相同目的。

数据--00888.zip

12.31 KB, 下载次数: 4

点评

没看懂，用一楼附件模拟一下结果发表于 2016-5-11 09:51

回复

使用道具举报

楼主| 发表于 2016-5-11 20:45 | 显示全部楼层

回复dsmch：再次上传一楼附件，内有模拟结果。

数据--0022.zip

46.19 KB, 下载次数: 5

回复

使用道具举报

发表于 2016-5-11 22:52 | 显示全部楼层本楼为最佳答案

这个最佳答案由 dsmch 给出，感谢 dsmch 的回答。

单击隐藏图章

Sub Macro1()
Dim arr, brr, w, d, i&, j%, k%
Set d = CreateObject("scripting.dictionary")
arr = Range("a2").CurrentRegion
n = UBound(arr)
ReDim brr(1 To n, 1 To 10)
For i = 1 To n
s = 0
For j = 1 To 4
For k = j + 1 To 5
s = s + 1
brr(i, s) = Val(Mid(arr(i, 3), j, 1) & Mid(arr(i, 3), k, 1))
Next
Next
Next
For j = 1 To 10
ReDim w(99)
For i = 1 To n
w(brr(i, j)) = n - 1 - i
d(w(brr(i, j))) = brr(i, j)
Next
Cells(1001, j + 22) = Application.Max(w)
Cells(1003, j + 22) = d(Application.Max(w))
d.RemoveAll
Next
End Sub

复制代码

评分

参与人数 1	+1	收起理由
hua221	+ 1	很给力！可惜系统只准评1分

查看全部评分

回复

使用道具举报

发新帖

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-4-26 12:35 , Processed in 0.609179 second(s), 19 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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