Excel 在某VBA程序中使用.find

我已经制作了发票表单和客户数据库，因此我可以轻松地为我的客户制作发票。我正在处理两张床单。表1包含发票表单，并有一个“查找联系人”宏按钮，该按钮按名称查找客户信息（在“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，它会问“这就是你搜索的客户吗？”如果它是否，它将转到下一个客户，直到找到正确的客户为止。如果（最终）它是是，它将继续复制所有内容并填写表格

我已经挣扎了好几天，找不到任何有效的方法。如果你能帮助我，那就太好了

您可以尝试以下方法：

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

Dim rngFound作为范围
Dim bNotTheGoodOne作为布尔值
“第一次搜索
设置rngFound=Sheets（“Sheet2”）.Columns（1）.Cells.Find（What:=customername，LookIn:=xlValues，LookAt:=xlPart，MatchCase:=False）
如果rngFound不算什么，那么
MsgBox“未找到客户”，仅适用于vbOKOnly
其他的
'存储第一个找到的地址以避免无休止的循环
FirstFound=rngFound.Address（False，False）
做
“询问是否是通缉客户
bNotTheGoodOne=MsgBox（“找到的客户：&rngFound.Cells（1,1.Value&.Find next？”，vbOKCancel）
如果不是那么好的话
工作表（“Sheet1”）.范围（“B12”）.值=rngFound.单元格（1,1）.值
工作表（“Sheet1”）.范围（“B13”）.值=rngFound.单元格（1,1）.偏移量（0,1）.值
其他的
“如果没有，请查找下一个匹配项
设置rngFound=wsSearch.Cells.FindNext（rngFound）
如果结束
非rngFound时的循环为Nothing，rngFound.Address（False，False）为FirstFound
如果结束

我找到了解决方案！增加：

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

---

无论如何谢谢你

嗯，这好像不管用。获取带有“Customer found:.find”的messagebox，即使不应该找到该名称。以及messagebox后面的错误“需要对象”。在第行：Set rngFound=wsSearch.Cells.FindNext（rngFound）