在某个 VBA 程序中使用 .find

Question

我已经制作了发票表格和客户 'database'，因此我可以轻松地为我的客户开具发票。我正在使用 2 sheets。 Sheet 1 包含发票表格，并有一个 "find contact" 宏按钮，可按名称定位客户信息（在范围 "B12" 中给出）。当在 sheet 2 中找到名称时，它会自动将信息复制到 sheet 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

如果它有一个询问 'is this the customer you searched for?' 的消息框，那就太好了。如果它是否，它将转到下一个客户，直到找到合适的客户。如果（最终）它是 YES，它将继续复制所有内容并填写表格。

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

Answer 1

你可以试试这个：

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

Answer 2

我找到解决办法了！新增：

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

谢谢！

在某个 VBA 程序中使用 .find

Using .find in a certain VBA program

excel

vba

copy

find