菜鸟请教大神，请协助修改代码

lisga1103

我用VBA做了一个通讯录查询的功能，sheet是查询页，输入想要查的人名即可显示其邮件和电话；sheet2为源数据。
代码见下文。但是有个问题，就是如果在sheet1中输入一个sheet2中没有的人名则提示错误，无法运行下去了，如果解决这个问题？
另外，是否有更简便的方法？
谢谢！请大神指教！代码：

Sub 取数()

  Dimicell

  Foricell = 2 To 100

  IfCells(icell, 1) <> "" Then

   Sheets(1).Cells(icell, 2) =Application.WorksheetFunction.VLookup(Sheets(1).Cells(icell, 1),Sheets(2).Range("A:c"), 2, False)

   Sheets(1).Cells(icell, 3) =Application.WorksheetFunction.VLookup(Sheets(1).Cells(icell, 1),Sheets(2).Range("A:c"), 3, False)

Else

Exit For

  EndIf

Next

End Sub

hhjjpp

vba里还去用公式领域也表现欠佳的vlookup，还重复找两回，不像乌龟一样吗？

hhjjpp

1. Private Sub CommandButton1_Click()
   
2. Dim arr, brr, result, n, i, j
   
3. arr = Sheet2.[a2].CurrentRegion
   
4. n = [a65536].End(xlUp).Row - 1
   
5. brr = [a2].Resize(n)
   
6. ReDim result(1 To n, 1 To 2)
   
7. For i = 1 To UBound(brr)
   
8.     For j = 2 To UBound(arr)
   
9.         If arr(j, 1) = brr(i, 1) Then
   
10.            result(i, 1) = arr(j, 2)
    
11.            result(i, 2) = arr(j, 3)
    
12.         End If
    
13.     Next
    
14. Next
    
15. [b2].Resize(n, 2) = result
    
16. End Sub
    

复制代码

lisga1103

谢谢啊！虽然看不太懂，还是太感谢了！

hhjjpp

加一条关键的提速语句

1. Private Sub CommandButton1_Click()
   
2. Dim arr, brr, result, n, i, j
   
3. arr = Sheet2.[a2].CurrentRegion
   
4. n = [a65536].End(xlUp).Row - 1
   
5. brr = [a2].Resize(n)
   
6. ReDim result(1 To n, 1 To 2)
   
7. For i = 1 To UBound(brr)
   
8.     For j = 2 To UBound(arr)
   
9.         If arr(j, 1) = brr(i, 1) Then
   
10.            result(i, 1) = arr(j, 2)
    
11.            result(i, 2) = arr(j, 3)
    
12.            Exit For
    
13.         End If
    
14.     Next
    
15. Next
    
16. [b2].Resize(n, 2) = result
    
17. End Sub
    

复制代码

lisga1103

谢谢！
多问一句，如果里面有重名的怎么办？