A列编号查找

thb5331232

根据单元格中的编号快速找到A列对应的编号，谢谢了！

金樽空对月

详见附件

hasyh2008

Sub tt()
  Dim arr, Rc%
  arr = Sheet1.Range("A2").CurrentRegion
  For Rc = 1 To UBound(arr)
    If arr(Rc, 1) = Sheet1.Range("D1") Then
      Application.Goto Reference:=Sheet1.Cells(Rc + 1, 1), scroll:=True
      Exit Sub
    End If
  Next Rc
  MsgBox "无此数！"
End Sub

thb5331232

hasyh2008 发表于 2022-5-28 16:10
Sub tt()
  Dim arr, Rc%
  arr = Sheet1.Range("A2").CurrentRegion

谢谢了，是我要的效果！

hasyh2008

thb5331232 发表于 2022-5-28 16:18
谢谢了，是我要的效果！

再加句 Msgbox "无此数！"

thb5331232

金樽空对月 发表于 2022-5-28 16:06
详见附件

非常好用，谢谢帮助！

thb5331232

老师，如果D1单元格是在SHEE2工作表代码怎样改？谢谢！

hasyh2008

呵呵！！

Sub tt()
  Dim arr, Rc%
  arr = Sheet1.Range("A2").CurrentRegion
  For Rc = 1 To UBound(arr)
    If arr(Rc, 1) = Sheet2.Range("D1") Then
      Application.Goto Reference:=Sheet1.Cells(Rc + 1, 1), scroll:=True
      Exit Sub
    End If
  Next Rc
  MsgBox "无此数！"
End Sub

金樽空对月

thb5331232 发表于 2022-5-28 19:41
老师，如果D1单元格是在SHEE2工作表代码怎样改？谢谢！

1. Sub myselect()
   
2. On Error Resume Next
   
3. Dim x%, n%, rg As Range
   
4. With Sheets("数据源")
   
5.     For x = 3 To .Range("a65536").End(3).Row
   
6.         If .Cells(x, 1) = ActiveSheet.Range("d1") Then
   
7.             n = n + 1
   
8.             If n = 1 Then Set rg = .Cells(x, 1)
   
9.             Set rg = Union(rg, .Cells(x, 1))
   
10.         End If
    
11.     Next x
    
12.     .Activate
    
13.     rg.Select
    
14. End With
    
15. If n = 0 Then MsgBox "此编号不存在！"
    
16. End Sub

复制代码

thb5331232

hasyh2008 发表于 2022-5-28 16:10
Sub tt()
  Dim arr, Rc%
  arr = Sheet1.Range("A2").CurrentRegion

再次感谢您，就是这样的！