[已解决]关于在excel中使用VBA实现查找符合条件的多条记录的问题

liymaum

关于在excel中使用VBA实现查找符合条件的多条记录的问题
我在网络上找到了可以实现查找符合条件的多条记录的自定义函数的办法，完全可以实现我想要的结果，但有一个最大的问题，就是执行效率非常的低，只要改动一下原始数据，整个表就要重算一遍，重算时间得用上好几分钟，现在我表中还只设置了一个库房的数据公式，那要把几个库房的都给设上公式，那不要好几个小时啊。
请各位大哥些帮我优化下这个程序嘛，谢谢。
同时也感谢写这个自定义函数的人，要是excel哪天自带这个函数就更好了。

'Vlookup_each("mp3",A2:A6,B2:B99,2)，查找符合条件的多条记录。
Vlookup_each(条件,判断条件的区域条件,符合条件需要显示的区域,第几条记录)
zl46v5io.rar (19.63 KB, 下载次数: 192)

2010-6-4 09:40 上传

点击文件名下载附件
关于在excel中使用VBA实现查找符合条件的多条记录的问题

最佳答案

月排行榜 / 总排行榜

amulee

2010-6-4 10:50

我这里测试正常啊

Public Function Vlookup_each(Lookup_value As String, Lookup_vector As Range, Result_vector As Range, K As Integer)
    If K <= 0 Or (K Mod 1) <> 0 Then
        Vlookup_each = "#REF!"
        Exit Function
    End If
    Dim i&, j&
    Dim Arr
    Arr = WorksheetFunction.Index(Lookup_vector, 0, 1)
    For j = 1 To UBound(Arr)
        If Arr(j, 1) = Lookup_value Then
            i = i + 1
            If i = K Then
                Vlookup_each = Result_vector(j, 1)
                Exit Function
            End If
        End If
    Next
    If i = 0 Or K > i Then
        Vlookup_each = ""
    End If
End Function

跳转到最佳答案楼层

amulee

'Vlookup_each("mp3",A2:A6,B2:B99,2)£¬²éÕÒ·ûºÏÌõ¼þµÄ¶àÌõ¼Ç¼£¬Vlookup_each(Ìõ¼þ,ÅжÏÌõ¼þµÄÇøÓòÌõ¼þ,·ûºÏÌõ¼þÐèÒªÏÔʾµÄÇøÓò,µÚ¼¸Ìõ¼Ç¼)
Public Function Vlookup_each(Lookup_value As String, Lookup_vector As Range, Result_vector As Range, K As Integer)

If K <= 0 Or (K Mod 1) <> 0 Then
    Vlookup_each = "#REF!"
    Exit Function
End If
Dim cell As Range
Dim i As Integer
Dim cellrow As Range
Dim Arr
Arr = WorksheetFunction.Index(Lookup_vector, 0, 1)
For Each cell In Arr
    If cell.Value = Lookup_value Then
        i = i + 1
            If i = K Then
                Set cellrow = Worksheets(cell.Parent.Name).Range(cell.Row & ":" & cell.Row)
                Vlookup_each = Intersect(cellrow, Result_vector).Value
                Exit Function
            End If
    End If
        Next
    If i = 0 Or K > i Then
        Vlookup_each = ""
    End If

End Function

BAIXINGR

学习下

开辆小富康

这个帖子不错，把电脑的心电图拿出来，证明原公式效率低。十分地形象，OK

liymaum

我按2楼的改了，执行效率确实快了去了，但是没有取出数来，提示出错了。

6ZTwveae.rar (18.12 KB, 下载次数: 77)

2010-6-4 10:28 上传

点击文件名下载附件
关于在excel中使用VBA实现查找符合条件的多条记录的问题

amulee

Public Function Vlookup_each(Lookup_value As String, Lookup_vector As Range, Result_vector As Range, K As Integer)
    If K <= 0 Or (K Mod 1) <> 0 Then
        Vlookup_each = "#REF!"
        Exit Function
    End If
    Dim cell
    Dim i As Integer
    Dim cellrow As Range
    Dim Arr
    Arr = WorksheetFunction.Index(Lookup_vector, 0, 1)
    For j = 1 To UBound(Arr)
        If Arr(j, 1) = Lookup_value Then
            i = i + 1
            If i = K Then
                Vlookup_each = Result_vector(j, 1)
                Exit Function
            End If
        End If
    Next
    If i = 0 Or K > i Then
        Vlookup_each = ""
    End If
End Function

liymaum

还是不对，再麻烦哥哥改下。 pvDtSdjX.rar (17.26 KB, 下载次数: 157)

2010-6-4 10:47 上传

点击文件名下载附件

[此贴子已经被作者于2010-6-4 10:47:01编辑过]

amulee

我这里测试正常啊

Public Function Vlookup_each(Lookup_value As String, Lookup_vector As Range, Result_vector As Range, K As Integer)
    If K <= 0 Or (K Mod 1) <> 0 Then
        Vlookup_each = "#REF!"
        Exit Function
    End If
    Dim i&, j&
    Dim Arr
    Arr = WorksheetFunction.Index(Lookup_vector, 0, 1)
    For j = 1 To UBound(Arr)
        If Arr(j, 1) = Lookup_value Then
            i = i + 1
            If i = K Then
                Vlookup_each = Result_vector(j, 1)
                Exit Function
            End If
        End If
    Next
    If i = 0 Or K > i Then
        Vlookup_each = ""
    End If
End Function

liymaum

呵呵，不好意思，我用的excel2007的，没注意到提示的启用宏，谢谢了。