设为首页收藏本站

开启辅助访问

Excel精英培训网»论坛 › Excel 求助区 › Excel VBA开发 › 查找倒数第二最大值和限定条件最小值

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

发新帖

查看: 3465|回复: 6

[已解决]查找倒数第二最大值和限定条件最小值

发表于 2017-1-23 23:05 | 显示全部楼层 |阅读模式

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

各位大侠，有问题请教大家，我想用VBA实现查找倒数第二最大值和限定条件最小值，详细数据见附件，谢谢！

最佳答案

月排行榜 / 总排行榜

grf1973

2017-1-24 09:55

这题目口味有点重。。。。。。

Sub tt()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
brr = Sheets("配种记录").[a1].CurrentRegion
For i = 3 To UBound(brr)
d(brr(i, 1)) = d(brr(i, 1)) & "," & brr(i, 2)
Next
brr = Sheets("产犊记录").[a1].CurrentRegion
For i = UBound(brr) To 3 Step -1
d1(brr(i, 1)) = d1(brr(i, 1)) & "," & brr(i, 3)
Next
arr = Range("a7:h18")
For i = 2 To UBound(arr)
x = arr(i, 2)
If d.exists(x) Then '配种：大于指定日期的最小日期
xrr = Split(d(x), ",")
For k = 1 To UBound(xrr)
If CDate(xrr(k)) > CDate(arr(i, 6)) Then
arr(i, 5) = xrr(k)
Exit For
End If
Next
End If
If d1.exists(x) Then '产犊：倒数第二
xrr = Split(d1(x), ",")
If UBound(xrr) >= 2 Then arr(i, 8) = xrr(2)
End If
Next
[e7].Resize(UBound(arr)) = Application.Index(arr, , 5)
[h7].Resize(UBound(arr)) = Application.Index(arr, , 8)
End Sub

复制代码

跳转到最佳答案楼层

最大值, 倒数

相关帖子

excel精英培训的微信平台，每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程

回复

使用道具举报

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

楼主| 发表于 2017-1-23 23:07 | 显示全部楼层

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

这是附件

查找到数第二日期和限条件最小值.zip

54.94 KB, 下载次数: 10

回复

使用道具举报

发表于 2017-1-24 09:55 | 显示全部楼层本楼为最佳答案

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

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

单击隐藏图章

这题目口味有点重。。。。。。

Sub tt()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
brr = Sheets("配种记录").[a1].CurrentRegion
For i = 3 To UBound(brr)
d(brr(i, 1)) = d(brr(i, 1)) & "," & brr(i, 2)
Next
brr = Sheets("产犊记录").[a1].CurrentRegion
For i = UBound(brr) To 3 Step -1
d1(brr(i, 1)) = d1(brr(i, 1)) & "," & brr(i, 3)
Next
arr = Range("a7:h18")
For i = 2 To UBound(arr)
x = arr(i, 2)
If d.exists(x) Then '配种：大于指定日期的最小日期
xrr = Split(d(x), ",")
For k = 1 To UBound(xrr)
If CDate(xrr(k)) > CDate(arr(i, 6)) Then
arr(i, 5) = xrr(k)
Exit For
End If
Next
End If
If d1.exists(x) Then '产犊：倒数第二
xrr = Split(d1(x), ",")
If UBound(xrr) >= 2 Then arr(i, 8) = xrr(2)
End If
Next
[e7].Resize(UBound(arr)) = Application.Index(arr, , 5)
[h7].Resize(UBound(arr)) = Application.Index(arr, , 8)
End Sub

复制代码

查找到数第二日期和限条件最小值.rar

52 KB, 下载次数: 9

回复

使用道具举报

楼主| 发表于 2017-1-24 11:17 | 显示全部楼层

问题完美解决，谢谢了

回复

使用道具举报

发表于 2017-1-25 17:37 | 显示全部楼层

grf1973 发表于 2017-1-24 09:55
这题目口味有点重。。。。。。

VBA登分花名册汇总

http://www.excelpx.com/thread-427374-1-1.html

回复

使用道具举报

发表于 2017-1-28 10:46 | 显示全部楼层

大于指导日期的配种日期的次数:

Sub tt()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
brr = Sheets("配种记录").[a1].CurrentRegion
For i = 3 To UBound(brr)
d(brr(i, 1)) = d(brr(i, 1)) & "," & brr(i, 2)
Next
brr = Sheets("产犊记录").[a1].CurrentRegion
For i = UBound(brr) To 3 Step -1
d1(brr(i, 1)) = d1(brr(i, 1)) & "," & brr(i, 3)
Next
arr = Range("a7:h18")
For i = 2 To UBound(arr)
x = arr(i, 2)
If d.exists(x) Then '配种：大于指定日期的最小日期
xrr = Split(d(x), ",")
For k = 1 To UBound(xrr)
If CDate(xrr(k)) > CDate(arr(i, 6)) Then
arr(i, 5) = xrr(k)
s = s + UBound(xrr) - k + 1 '大于指定日期的配种日期的次数
Exit For
End If
Next
End If
If d1.exists(x) Then '产犊：倒数第二
xrr = Split(d1(x), ",")
If UBound(xrr) >= 2 Then arr(i, 8) = xrr(2)
End If
Next
[e7].Resize(UBound(arr)) = Application.Index(arr, , 5)
[h7].Resize(UBound(arr)) = Application.Index(arr, , 8)
MsgBox "大于指定日期的配种日期的次数为：" & s & "次"
End Sub

复制代码

查找到数第二日期和限条件最小值.rar

52.26 KB, 下载次数: 11

评分

参与人数 1	+6	收起理由
laoau138	+ 6	来学习

查看全部评分

回复

使用道具举报

楼主| 发表于 2017-1-28 21:09 | 显示全部楼层

大侠，新年快乐，大过年的还给解答真是感激不尽！

回复

使用道具举报

发新帖

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

GMT+8, 2024-4-26 14:38 , Processed in 0.398336 second(s), 14 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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