[已解决]VBA_查找数据代码修改

yjwdjfqb

Public Sub 查找数据()
    Dim myRange1 As Range
    Dim myRange2 As Range
    Dim myRow  As Long
    Dim str As String
   
    str = InputBox("请输入查找内容：")
    If str = "" Then End
    Set myRange1 = Cells       '指定查询范围
    On Error Resume Next
    myRow = WorksheetFunction.Match(str, myRange1, 0)    '指定查询条件
    On Error GoTo 0
    If myRow = 0 Then
        MsgBox "没有找到符合条件的单元格"
    Else
        Set myRange2 = myRange1.Cells(myRow)
        MsgBox "符合条件的单元格为：" & myRange2.Address(False, False)
        myRange2.EntireRow.Select
    End If
    Set myRange1 = Nothing
    Set myRange2 = Nothing
End Sub

想请大家修改成　查询当前工作表B4：J500这个区域内容
查询的内容，改为　提示框中输入内容，就是当我们执行本宏命令时，弹出一个提示框，让我们输入查找的字符后，确定，首先显示查找字符的位置，确定后，光标选中查找字符所在的行。

请老师们帮忙。。谢谢大家

最佳答案

月排行榜 / 总排行榜

那么的帅

2011-8-15 11:00

回复 yjwdjfqb 的帖子

1. 
   
2. Public Sub 查找数据()
   
3.     Dim myRange1 As Range
   
4.     Dim myRange2 As Range
   
5.     Dim myRow As Long
   
6.     Dim str As String
   
7.     On Error Resume Next
   
8.    
   
9.     str = InputBox("请输入查找内容：")
   
10.     If str = "" Then End
    
11.     Set myRange1 = ActiveSheet.Range("B4:J500")       '指定查询范围
    
12.     With myRange1
    
13.         Set c = .Find(str, LookIn:=xlValues)
    
14.         If Not c Is Nothing Then
    
15.             firstAddress = c.Address(0, 0)
    
16.             Do
    
17.                 Set c = .FindNext(c)
    
18.             Loop While Not c Is Nothing And c.Address(0, 0) <> firstAddress
    
19.         End If
    
20.     End With
    
21.     If c Is Nothing Then
    
22.         MsgBox "没有找到符合条件的单元格"
    
23.     Else
    
24.         MsgBox "符合条件的单元格为：" & firstAddress
    
25.         Range(firstAddress).EntireRow.Select
    
26.     End If
    
27. End Sub
    

复制代码

跳转到最佳答案楼层

那么的帅

回复 yjwdjfqb 的帖子

1. 
   
2. Public Sub 查找数据()
   
3.     Dim myRange1 As Range
   
4.     Dim myRange2 As Range
   
5.     Dim myRow  As Long
   
6.     Dim str As String
   
7.    
   
8.     str = InputBox("请输入查找内容：")
   
9.     If str = "" Then End
   
10.     Set myRange1 = ActiveSheet.Range("B4:J500")       '指定查询范围
    
11.     On Error Resume Next
    
12.     myRow = WorksheetFunction.Match(str, myRange1, 0)    '指定查询条件
    
13.     On Error GoTo 0
    
14.     If myRow = 0 Then
    
15.         MsgBox "没有找到符合条件的单元格"
    
16.     Else
    
17.         Set myRange2 = myRange1.Cells(myRow)
    
18.         MsgBox "符合条件的单元格为：" & myRange2.Address(False, False)
    
19.         myRange2.EntireRow.Select
    
20.     End If
    
21.     Set myRange1 = Nothing
    
22.     Set myRange2 = Nothing
    
23. End Sub
    

复制代码

yjwdjfqb

回复 那么的帅 的帖子

帅哥，我测试了下，不行，麻烦传个附件好吧

那么的帅

回复 yjwdjfqb 的帖子

晕倒，让我提供附件？

yjwdjfqb

回复 那么的帅 的帖子

哦，搞错了，应该是我上传个附件给帅哥，帮忙解决下才对，，

不好意思帅哥。。

请看下这个附件问题在那儿。。
谢谢！！！

那么的帅

回复 yjwdjfqb 的帖子

1. 
   
2. Public Sub 查找数据()
   
3.     Dim myRange1 As Range
   
4.     Dim myRange2 As Range
   
5.     Dim myRow As Long
   
6.     Dim str As String
   
7.     On Error Resume Next
   
8.    
   
9.     str = InputBox("请输入查找内容：")
   
10.     If str = "" Then End
    
11.     Set myRange1 = ActiveSheet.Range("B4:J500")       '指定查询范围
    
12.     With myRange1
    
13.         Set c = .Find(str, LookIn:=xlValues)
    
14.         If Not c Is Nothing Then
    
15.             firstAddress = c.Address(0, 0)
    
16.             Do
    
17.                 Set c = .FindNext(c)
    
18.             Loop While Not c Is Nothing And c.Address(0, 0) <> firstAddress
    
19.         End If
    
20.     End With
    
21.     If c Is Nothing Then
    
22.         MsgBox "没有找到符合条件的单元格"
    
23.     Else
    
24.         MsgBox "符合条件的单元格为：" & firstAddress
    
25.         Range(firstAddress).EntireRow.Select
    
26.     End If
    
27. End Sub
    

复制代码

yjwdjfqb

回复 那么的帅 的帖子

谢谢帅哥，问题解决了！！！