如何用VBA定位与某值最接近的数据首次出现的行号？

aoe1981

　　给定一个值n，在一列数据中进行查找、判断、定位并返回所在行号，依据是与该值n的差的绝对值最小，且是首次出现……
　　要求：1.不用vlookup函数等，用vba代码解决；
　　　　　2.尽量减少循环。
　　附件： VBA定位行.rar (3.44 KB, 下载次数: 42)

2014-7-28 09:44 上传

点击文件名下载附件

　　当然，附件中的值是随机的。图如下：
　　

aoe1981

打字错误：“和等号”应该为“的行号”……不好意思……

wzsy2_mrf

扫描一遍就可以了。

1. Sub aa()
   
2.     Dim arr, myrow&, mMin&, myval&, i&
   
3.     arr = Range("A2").CurrentRegion
   
4.     myval = Cells(1, 4)
   
5.     mMin = Abs(arr(1, 1) - myval)
   
6.     myrow = 1
   
7. 
   
8.     For i = 2 To UBound(arr)
   
9.         If Abs(arr(i, 1) - myval) < mMin Then mMin = Abs(arr(i, 1) - myval): myrow = i
   
10.     Next
    
11.     MsgBox "第一次出现最接近的行:" & myrow
    
12. End Sub
    

复制代码

aoe1981

wzsy2_mrf 发表于 2014-7-28 10:09
扫描一遍就可以了。

首先将目标值与第一个值做减法（mMin = Abs(arr(1, 1) - myval)），存储其差的绝对值，便于接下来的比较，很是巧妙！

aoe1981

wzsy2_mrf 发表于 2014-7-28 10:09
扫描一遍就可以了。

您的这个方法即将在我接下来的帖子中应用，届时烦请围观下……呵呵，对我启发太大了，真是感谢……我考虑到了死角，都感觉要用两三层循环了，您这个够厉害！

aoe1981

wzsy2_mrf 发表于 2014-7-28 10:09
扫描一遍就可以了。

您的代码也可以修改为首次与最大值比较，然后来一个完整循环：

1. Sub aa1() '网友提供，精彩方法
   
2.     Dim arr, myrow&, mMin&, myval&, i&
   
3.     arr = Range("A2").CurrentRegion
   
4.     myval = Cells(1, 4)
   
5.     mMin = Abs(WorksheetFunction.Max(arr) - myval)
   
6.     myrow = 1
   
7. 
   
8.     For i = 1 To UBound(arr)
   
9.         If Abs(arr(i, 1) - myval) < mMin Then mMin = Abs(arr(i, 1) - myval): myrow = i
   
10.     Next
    
11.     MsgBox "第一次出现最接近的行:" & myrow
    
12. End Sub

复制代码

这样在特殊情况下是有好处的……

aoe1981

wzsy2_mrf 发表于 2014-7-28 10:09
扫描一遍就可以了。

　　不好意思，前面的说法有点漏洞，应当与2倍的最大值比较，防止目标数据就是最大值本身！代码修改为（可以减少首次行号预赋值的代码）：

1. Sub aa1() '网友提供，精彩方法
   
2.     Dim arr, myrow&, mMin&, myval&, i&
   
3.     arr = Range("A2").CurrentRegion
   
4.     myval = Cells(1, 4)
   
5.     mMin = Abs(WorksheetFunction.Max(arr) * 2 - myval)
   
6. 
   
7.     For i = 1 To UBound(arr)
   
8.         If Abs(arr(i, 1) - myval) < mMin Then mMin = Abs(arr(i, 1) - myval): myrow = i
   
9.     Next
   
10.     MsgBox "第一次出现最接近的行:" & myrow
    
11. End Sub

复制代码

wzsy2_mrf

aoe1981 发表于 2014-7-28 11:32
　　不好意思，前面的说法有点漏洞，应当与2倍的最大值比较，防止目标数据就是最大值本身！代码修改为（可 ...

说句不客气的话，你以上两个程序都是没有必要的。第一，调用工作表函数也是要花费时间的，而这个工作表函数作用的时候已经扫描过全部数据一遍，而这扫描一遍的时间的早已可把工作做完，而你才刚刚开始，这等于是在做无用功。第二，如果是求最小数的话，那么mMin有初始设定应该 >=数据集中的最小数，越接近越好；只有这样才能减少交换次数；而求最大数的时候刚好相反。但最小数、最大数是那一个你原先那里知道，既然如此，你就在数据集中随便选一个好了。

aoe1981

wzsy2_mrf 发表于 2014-7-28 12:27
说句不客气的话，你以上两个程序都是没有必要的。第一，调用工作表函数也是要花费时间的，而这个工作表函 ...

呵呵，您说的有道理……但是您不明白我应用的具体情况……假设我的A列数据源按某一属性分为两组，不妨设为男子组和女子组，当要比较的目标数据也有这一属性时，比如D1单元格为女子组的数据，匹配时只能从女子组里匹配时，我的思路有所便捷……当然，男子组与女子组的最大值是已知的……呵呵
具体还请关注不久要发布的我的新帖中的应用！

张三李四

楼主的一楼说明中写明了“不用vlookup函数等”，楼主的代码中已经用了“WorksheetFunction.Max”，犯规了