求师傅赐教“输入接近数值”问题，谢谢~

大氵寿

test.rar (6.37 KB, 下载次数: 3)

2012-9-14 22:18 上传

点击文件名下载附件

如果分别计算L与M列的差额绝对值和的最小值，并匹配他的工时，我做了个附件的思路，可以直接用函数公式就可以解决，缺点是我加了一个辅助列。
你看看，是否有参考价值。

大氵寿

vba:

Sub t()
Dim L(2 To 2709) As Long
Dim i, a, b As Integer
For i = 2 To 2709
    If Cells(i, 19) = "" Then
        For a = 2 To 2709
        L(a) = Abs(Cells(i, 12) - Cells(a, 12)) + Abs(Cells(i, 13) - Cells(a, 13))
            If Cells(a, 19) = "" Then
            L(a) = 11111
            End If
        Next
        b = Application.Match(Application.WorksheetFunction.Min(L), L, 0)
        Cells(i, 19) = Cells(b + 1, 19)
    End If
Next
End Sub


这个应该可以解决你的问题。。

大氵寿

玫瑰蝴蝶雨 发表于 2012-9-14 22:10
好像是个好思路啊，您能帮忙做一下吗？谢谢~~

vba代码我改了一下，第一次的代码有点问题， 你看看，应该可以，我本地测试可以。 代码在楼上。

玫瑰蝴蝶雨

大氵寿 发表于 2012-9-14 22:20
如果分别计算L与M列的差额绝对值和的最小值，并匹配他的工时，我做了个附件的思路，可以直接用函数公式 ...

感谢您这么晚还来解决我的问题，我下载后到其他数据中试一下，真的很感激您

玫瑰蝴蝶雨

大氵寿 发表于 2012-9-14 23:40
vba代码我改了一下，第一次的代码有点问题， 你看看，应该可以，我本地测试可以。 代码在楼上。

感谢您这么晚还来解决我的问题，我下载后到其他数据中试一下，真的很感激您，谢谢
另外有一点您看能否解决：我的表格不一定都有2709行，您能否改成从第2行开始到最后的非空行结束？我每次得到的数据都是从第二行开始，但是最后一行不一定是多少，我运行数据时时间跨度越大数据越多，您能给解决一下吗？

大氵寿

玫瑰蝴蝶雨 发表于 2012-9-15 06:09
感谢您这么晚还来解决我的问题，我下载后到其他数据中试一下，真的很感激您，谢谢
另外有一点您看能否解 ...

vba:


Sub t()
Dim i, a, b, k As Integer
Dim L() As Long
k = Range("L65536").End(xlUp).Row
ReDim L(k)
For i = 2 To k
    If Cells(i, 19) = "" Then
        For a = 2 To k
        L(a) = Abs(Cells(i, 12) - Cells(a, 12)) + Abs(Cells(i, 13) - Cells(a, 13))
            If Cells(a, 19) = "" Then
            L(a) = 11111
            End If
        Next
        b = Application.Match(Application.WorksheetFunction.Min(L), L, 0)
        Cells(i, 19) = Cells(b + 1, 19)
    End If
Next
End Sub

玫瑰蝴蝶雨

大氵寿 发表于 2012-9-15 06:53
vba:

大哥，您最后给我回复这个不行吧，怎么运行结果所有的都是“0.35”？这不对啊！请您亲自试试看

大氵寿

玫瑰蝴蝶雨 发表于 2012-9-17 19:57
大哥，您最后给我回复这个不行吧，怎么运行结果所有的都是“0.35”？这不对啊！请您亲自试试看

犯了个低级错误..sorry,

Sub t()
Dim i, a, b, k As Integer
Dim L() As Long
k = Range("L65536").End(xlUp).Row
ReDim L(2 to k)
For i = 2 To k
    If Cells(i, 19) = "" Then
        For a = 2 To k
        L(a) = Abs(Cells(i, 12) - Cells(a, 12)) + Abs(Cells(i, 13) - Cells(a, 13))
            If Cells(a, 19) = "" Then
            L(a) = 11111
            End If
        Next
        b = Application.Match(Application.WorksheetFunction.Min(L), L, 0)
        Cells(i, 19) = Cells(b + 1, 19)
    End If
Next
End Sub

玫瑰蝴蝶雨

大氵寿 发表于 2012-9-18 13:03
犯了个低级错误..sorry,

Sub t()

谢谢，非常感谢