在某個VBA程序中使用.find

Question

我已經制作了發票表單和客戶數據庫，因此我可以輕鬆爲客戶製作發票。我正在使用2張。工作表1包含發票表單，並有一個「查找聯繫人」macrobutton，通過名稱查找客戶信息（在範圍「B12」中給出）。在表2中找到名稱時，它會自動將信息複製到工作表1中。

唯一的問題是，我必須搜索完整的名稱，否則將無法找到它。如果我的聯繫人保存爲「Nicolas Cage」，則不能找到「Nicolas」。所以我想知道如果我可以集成在未來的代碼...

.Find(What:="", , LookIn:=xlValues, LookAt:=xlPart) 

（或其它可用於使它工作。）

...在此代碼，我用它來尋找信息和Sheet2中複製到工作表Sheet1：'這是你搜索的客戶

Option Explicit 

Sub ContactOproepen() 

Dim customername As String 
Dim Finalrow As Integer 
Dim i As Integer 

customername = Sheets("Sheet1").Range("B12").Value 
Finalrow = Sheets("Sheet1").Range("A1000").End(xlUp).Row 

For i = 2 To Finalrow 
    If Worksheets("Sheet2").Cells(i, 1) = customername Then 
     'Name 
     Worksheets("Sheet2").Cells(i, 1).Copy 
     Worksheets("Sheet1").Range("B12").PasteSpecial xlPasteFormulasAndNumberFormats 
     'Adress 
     Worksheets("Sheet2").Cells(i, 2).Copy 
     Worksheets("Sheet1").Range("B13").PasteSpecial xlPasteFormulasAndNumberFormats 
     'Postal & City 
     Worksheets("Sheet2").Cells(i, 3).Copy 
     Worksheets("Sheet1").Range("B14").PasteSpecial xlPasteFormulasAndNumberFormats 
     'Phonenumber 
     Worksheets("Sheet2").Cells(i, 4).Copy 
     Worksheets("Sheet1").Range("B15").PasteSpecial xlPasteFormulasAndNumberFormats 
     'E-mail 
     Worksheets("Sheet2").Cells(i, 5).Copy 
     Worksheets("Sheet1").Range("B16").PasteSpecial xlPasteFormulasAndNumberFormats 
    End If 

Next i 

Range("B12").Select 
Application.CutCopyMode = False 

If Range("B15") = "" Then 
    MsgBox "customer not found.", vbOKOnly, "Search customer" 

End If 


End Sub 

這將是巨大的，如果它有它要求一個MsgBox如果它是否它會轉到下一位客戶，直到找到合適的人。如果（最終）它是是它將繼續複製一切並填寫表格。

我一直在努力奮鬥幾天，找不到任何工作。如果你能幫助我，那會很棒！

Answer 1

我已經找到了解決方案！補充：

Dim foundrange As Range 

' 
Set foundrange = Sheets("Sheet2").Cells.Find(What:=Sheets("Sheet1").Range("B12").Value, LookIn:=xlFormulas, lookat:=xlPart) 

因此，代碼變爲：

Sub ContactOproepen() 
' 
Dim Finalrow As Integer 
Dim i As Integer 
Dim cC As Object 
Dim iR As Integer 
Dim foundrange As Range 

' 
Set foundrange = Sheets("Sheet2").Cells.Find(What:=Sheets("Sheet1").Range("B12").Value, LookIn:=xlFormulas, lookat:=xlPart) 


If Sheets("Sheet1").Range("B12").Value = "" Then 
    MsgBox "Fill in a name please", vbOKOnly, "Search customer" 

Else 
If foundrange Is Nothing Then 
    MsgBox "  Customer not found," & vbNewLine & vbNewLine & "  Try another searchkey.", vbOKOnly, "Search contact" 

Else 

     Finalrow = Sheets("Sheet1").Range("A1000").End(xlUp).Row 

     For i = 2 To Finalrow 
      If Worksheets("Sheet2").Cells(i, 1) = foundrange Then 
       'Name 
       Worksheets("Sheet2").Cells(i, 1).Copy 
       Worksheets("Sheet1").Range("B12").PasteSpecial xlPasteFormulasAndNumberFormats 
       'Adress 
       Worksheets("Sheet2").Cells(i, 2).Copy 
       Worksheets("Sheet1").Range("B13").PasteSpecial xlPasteFormulasAndNumberFormats 
       'Postal & City 
       Worksheets("Sheet2").Cells(i, 3).Copy 
       Worksheets("Sheet1").Range("B14").PasteSpecial xlPasteFormulasAndNumberFormats 
       'Phonenumber 
       Worksheets("Sheet2").Cells(i, 4).Copy 
       Worksheets("Sheet1").Range("B15").PasteSpecial xlPasteFormulasAndNumberFormats 
       'E-mail 
       Worksheets("Sheet2").Cells(i, 5).Copy 
       Worksheets("Sheet1").Range("B16").PasteSpecial xlPasteFormulasAndNumberFormats 

       Range("B12").Select 
      End If 
     Next i 

    Set cC = New clsMsgbox 
     cC.Title = "Search Customer" 
     cC.Prompt = "Added Customer" & vbNewLine & "" & vbNewLine & "Is this the customer you were looking for?" 
     cC.Icon = Question + DefaultButton2 
     cC.ButtonText1 = "Yes" 
     cC.ButtonText2 = "No" 
     iR = cC.MessageBox() 
     If iR = Button1 Then 
      'Leave content in range 
     ElseIf iR = Button2 Then 
      Range("B12:E16").Select 
      Selection.ClearContents 
      Range("B12").Select 

    Range("B12").Select 
    Application.CutCopyMode = False 
    End If 
    End If 
    End If 

    End Sub 

還是要謝謝你！

Answer 2

你可以試試這個：

Dim rngFound As Range 
Dim bNotTheGoodOne as Boolean 

'first search 
Set rngFound = Sheets("Sheet2").Columns(1).Cells.Find(What:=customername, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False) 

If rngFound Is Nothing Then 
    MsgBox "No customer found", vbOKOnly 
Else 
    'store first found address to avoid endless loop 
    FirstFound = rngFound.Address(False, False) 
    Do 
     'ask if it's the wanted customer 
     bNotTheGoodOne = MsgBox("Customer found: " & rngFound.Cells(1,1).Value & " . Find next ?", vbOKCancel) 
     If Not bNotTheGoodOne then 
      Worksheets("Sheet1").Range("B12").value = rngFound.Cells(1,1).Value 
      Worksheets("Sheet1").Range("B13").value = rngFound.Cells(1,1).offset(0,1).Value 
     Else 
      'if not, find next match 
      Set rngFound = wsSearch.Cells.FindNext(rngFound) 
     End if 
    Loop While Not rngFound Is Nothing And rngFound.Address(False, False) <> FirstFound 
End If