【已解决】如何通过查找定位功能，查找相应值

tobody

点击“查找”按钮实现定位查找功能:
按D1输入的值,查找从D列到E列之间范围内的值是否包含其中,如包含,直接定位到D列相应的单元格;如不包含,弹出对话框"没有查到您所要的值,是否指定相近值",点"是"定位到D或E列相应值,"否"退出.
相近值:比如查找2133380,没有找到,继续查找相近值为2133384.(向两侧扩散查找)

查找的目标如果是小于D3的值(是不是小于最小值的问题??),为什么提示,"运行时错误","不能取得类WorksheetFunction的 MATCH的属性??
帮将此问题解决一下吧,谢谢了

[ 本帖最后由 tobody 于 2008-12-10 13:29 编辑 ]

tobody

问题是有点复杂，帮帮忙

tobody

高手们快出手吧，着急啊

tobody

无语了！！！！！！！

northwolves

这个很简单的:

1. 
   
2. Private Sub CommandButton1_Click()
   
3. [d2].Offset(WorksheetFunction.Match([d1], [d3].Resize([d65536].End(xlUp).Row - 2), 1), 0).Select
   
4. End Sub
   

复制代码

northwolves

完整版本:

1. 
   
2. Private Sub CommandButton1_Click()
   
3. Dim r As Long, msg As Long
   
4. r = WorksheetFunction.Match([d1], [d3].Resize([d65536].End(xlUp).Row - 2), 1)
   
5. If [d1] <= [d2].Offset(r, 1) Then
   
6. [d2].Offset(r, 0).Select
   
7. Exit Sub
   
8. Else
   
9. msg = MsgBox("没有查到您所要的值,是否指定相近值?", vbOKCancel)
   
10. If msg = vbOK Then [d2].Offset(r, 0).Select
    
11. End If
    
12. End Sub
    

复制代码

tobody

狼行天下 大哥:

查找的目标如果是小于D3的值(是不是小于最小值的问题??),为什么提示,"运行时错误","不能取得类WorksheetFunction的 MATCH的属性??

帮将此问题解决一下吧,谢谢了

yzxiongvip

Sub 按当前单元文本定位()
ABC = Selection
Dim aa As Range
Cells(1, 3).Select
For Each a In ActiveSheet.UsedRange
Cells(1, 4).Select
If a Like ABC Then
If aa Is Nothing Then
Set aa = [d1].Cells
Else
Set aa = Union(aa, a.Cells)
End If
End If
Next
aa.Select
End Sub

northwolves

加一句即可

1. 
   
2. Private Sub CommandButton1_Click()
   
3. Dim r As Long, msg As Long
   
4. If [d1] < [d3] Then Exit Sub
   
5. r = WorksheetFunction.Match([d1], [d3].Resize([d65536].End(xlUp).Row - 2), 1)
   
6. If [d1] <= [d2].Offset(r, 1) Then
   
7. [d2].Offset(r, 0).Select
   
8. Exit Sub
   
9. Else
   
10. msg = MsgBox("没有查到您所要的值,是否指定相近值?", vbOKCancel)
    
11. If msg = vbOK Then [d2].Offset(r, 0).Select
    
12. End If
    
13. End Sub
    

复制代码

zhqang

Private Sub CommandButton1_Click()
Dim fc As Range
Set fc = Sheet1.Columns("D:E").Find(Cells(1, 4))

If fc.Address = "$D$1" Then
    If MsgBox("没有查到相匹配的值,是否需要临近值", vbYesNo) = vbYes Then
        Call compare
    End If
Else
   fc.Activate
End If
End Sub
Sub compare()
Dim i%, j%, k%, m&, n%, x%, y&
j = [D65536].End(xlUp).Row
y = 100000
For i = 4 To 5
    For k = 3 To j
         m = Abs(Cells(1, 4) - Cells(k, i))
         If y > m Then
         '把比较小的值的行列号保存下来
            n = k '保存行号
            x = i '保存列号
            y = m
         End If
         
    Next
    Debug.Print
Next
Cells(n, x).Activate
End Sub