VBA使用带有.find和.copy值的循环

时间:2015-10-30 00:01:11

标签: vba copy paste

我想在SearchFunction中使用一个循环来搜索客户,直到找到合适的客户。我使用自定义msgbox来定义找到的客户是否是我正在寻找的客户。

基本上我想要这个:

MsgBox "Is this the customer you were looking for?"

Yes: it will copy cells(sheet2) and paste them into the invoice (sheet1)
No:  it will find next customer (and ask same question)**

** And keep doing/asking this till last found customer is shown. 

这就是找到客户时msgbox的样子: Custom msgbox

目前,它会搜索客户并在自定义消息框中显示。当我说'是,这是客户'时,它会像应该的那样复制价值并将其粘贴在发票中。但是,当我说'不,这不是我的客户'它不会转到下一个找到的客户,但会退出SearchFunction。

我尝试过使用Loop但我无法使用它。我也试过.findnext但我无法将其嵌入到我使用的代码中。

这是我正在使用的代码:

Sub SearchCustomer()
 '
 ' Search for customer
 '
 '*****************************************************************************************************


Dim Finalrow As Integer
Dim I As Integer
Dim cC As Object
Dim iR As Integer
Dim foundrange As Range

 '*****************************************************************************************************
 '                                      This Searches for the customer
 '*****************************************************************************************************

' Set up searchrange
    Set foundrange = Sheets("sheet2").Cells.Find(What:=Sheets("sheet1").Range("B12").Value, LookIn:=xlFormulas, LookAt:=xlPart)

' Checks if fields are filled
If Sheets("sheet1").Range("B12").Value = "" Then
    MsgBox "Please fill in a search key", vbOKOnly, "Search customer"

Else

    'When nothing is found
    If foundrange Is Nothing Then
        MsgBox "Customer not found," & vbNewLine & vbNewLine & "Refine your search key", vbOKOnly, "Search customer"

    Else

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

        For I = 2 To Finalrow

            'When range is found
            If Worksheets("sheet2").Cells(I, 1) = foundrange Then
                Set cC = New clsMsgbox
                cC.Title = "Search contact"
                cC.Prompt = "Is this the customer you searched for?" & vbNewLine & "" & vbNewLine & Worksheets("sheet2").Cells(I, 1) & vbNewLine & Worksheets("sheet2").Cells(I, 2) _
                & vbNewLine & Worksheets("sheet2").Cells(I, 3) & vbNewLine & Worksheets("sheet2").Cells(I, 4) & vbNewLine & Worksheets("sheet2").Cells(I, 5)
                cC.Icon = Question + DefaultButton2
                cC.ButtonText1 = "Yes"
                cC.ButtonText2 = "No"
                 iR = cC.MessageBox()

                If iR = Button1 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
                    'Zipcode & 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

                ElseIf iR = Button2 Then
                    MsgBox "Customer not found", vbOKOnly, "Contact zoeken"

                End If

                Range("B12").Select

            End If 'gevonden item
        Next I

    Application.CutCopyMode = False

    End If
End If

End Sub

一些帮助会很棒!已经找了很久了。

先谢谢!

Greets Mikos

2 个答案:

答案 0 :(得分:0)

您需要重新构建代码,For循环对于循环搜索结果没有意义。您需要Do While循环,请参阅Range.FindNext Method

中的示例

伪代码:

let vc = storyboard.instantiateViewControllerWithIdentifier("someViewController") as! UIViewController

P.S。 这些不是您正在寻找的机器人!

答案 1 :(得分:0)

非常感谢Andre451因为他解决了我的问题!

最终代码:

Sub SearchCustomer()
 '
 ' Search customer
 '
 '*****************************************************************************************************

    Dim Finalrow As Integer
    Dim foundrange As Range
    Dim answer As Integer

 '*****************************************************************************************************
 '                                      Search for customername
 '*****************************************************************************************************
' Search Range
Set foundrange = Sheets("sheet2").Cells.Find(What:=Sheets("sheet1").Range("B12").Value, LookIn:=xlFormulas, LookAt:=xlPart)
Finalrow = Sheets("sheet1").Range("A:A").End(xlDown).Row

' Checks if search range is filled
If Sheets("sheet1").Range("B12").Value = "" Then
    MsgBox "Please fill in a searchkey", vbOKOnly, "Search customer"
Else
    Do While Not foundrange Is Nothing
        If MsgBox("Is this the customer you were looking for? " & foundrange, vbYesNo + vbQuestion, "Zoek klant") = vbYes Then
            'Name
            foundrange.Copy
            Worksheets("sheet1").Range("B12").PasteSpecial xlPasteFormulasAndNumberFormats
            'Address
            foundrange.Offset(0, 1).Copy
            Worksheets("sheet1").Range("B13").PasteSpecial xlPasteFormulasAndNumberFormats
            'Zipcode and City
            foundrange.Offset(0, 2).Copy
            Worksheets("sheet1").Range("B14").PasteSpecial xlPasteFormulasAndNumberFormats
            'Phonenumber
            foundrange.Offset(0, 3).Copy
            Worksheets("sheet1").Range("B15").PasteSpecial xlPasteFormulasAndNumberFormats
            'Email
            foundrange.Offset(0, 4).Copy
            Worksheets("sheet1").Range("B16").PasteSpecial xlPasteFormulasAndNumberFormats
            Exit Do
        Else
            Set foundrange = Sheets("sheet2").Cells.FindNext(After:=foundrange)
            End If
Loop

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

End If
End Sub

再次感谢!