搜索每一行,粘贴每个匹配项 - Excel VBA

时间:2016-10-14 13:15:32

标签: excel vba

所以我可以搜索但是我遇到了循环问题,这里有一些上下文的例子:

Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("DCCUEQ").Range("1:20") 'searches all of rows 1 to 20
    Set Rng = .Find(What:=FindString, _
                    After:=.Cells(.Cells.Count), _
                    LookIn:=xlValues, _
                    LookAt:=xlWhole, _
                    SearchOrder:=xlByRows, _
                    SearchDirection:=xlNext, _
                    MatchCase:=False)
    If Not Rng Is Nothing Then
        Application.Goto Rng, True 'value found
        MsgBox ("Value Found" & Rng)
    Else
        MsgBox "Nothing found" 'value not found
    End If
End With
End If
End Sub

我需要做一些事情

如果FindString在一行上,请从第5行开始将该行(从A:F)复制并粘贴到Sheet3 跳过该行的其余部分并搜索DCCUEQ上的下一行 如果满足要求,则检查并粘贴在先前粘贴的行(在Sheet3上)下 循环这个直到在行上找不到信息

它是大型程序的一部分,所以如果我能在填写这部分代码方面得到一些帮助,我可以通过遵循逻辑轻松完成其余的工作

请帮助我获得答案的任何帮助或指示信息。

2 个答案:

答案 0 :(得分:3)

我认为使用2 For循环(一个用于列,一个用于行)将在您的上下文中完美地工作。

您设置一个包含地址的两个变量的单元格,并将其与您的字符串进行比较。如果它是相同的,那么你复制/粘贴并退出列的循环,以便它跳过行的其余部分。

Sub Find_First()

Dim FindString As String
Dim Rng As Range
FindString = InputBox("Enter a Search value")

    If Trim(FindString) <> "" Then

        With Sheets("DCCUEQ")

            Dim s3r As Integer, i As Integer, j As Integer
            s3r = 4 'this would determine the row in Sheet3

            For i = 1 To 20

                For j = 1 To 10 'Let's say the last column is J

                    Set Rng = .Cells(i, j)

                    If Rng = FindString Then
                        s3r = s3r + 1
                        .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 6)).Copy Destination:=Worksheets("Sheet3").Range(Worksheets("Sheet3").Cells(s3r, 1), Worksheets("Sheet3").Cells(s3r, 6))
                        Exit For 'it will go to the next row
                    End If

                Next j

            Next i

            If s3r = 4 Then MsgBox "Nothing found"

        End With

    End If

End Sub

如果这种方式适合你,请告诉我。

答案 1 :(得分:2)

坚持使用Find,因为您可能想要复制格式。注意Rng0是为了防止在发现回绕时出现无限循环。

Sub Find_First()

Dim Rng As Range
Dim Rng0 As Range
Dim NextRow As Integer
Dim FindString As String
FindString = InputBox("Enter a Search value")

Dim dest As Worksheet
Set dest = Worksheets("Sheet3")

If Trim(FindString) <> "" Then
   With Sheets("DCCUEQ").Range("1:20")
      Set Rng0 = .Find(What:=FindString, _
                After:=.Cells(.Cells.Count), _
                LookIn:=xlValues, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlNext, _
                MatchCase:=False)
      NextRow = 5
      Set Rng = Rng0
      While Not Rng Is Nothing
         .Range(.Cells(Rng.Row, 1), .Cells(Rng.Row, 6)).Copy dest.Range(dest.Cells(NextRow, 1), dest.Cells(NextRow, 6))
         NextRow = NextRow + 1
         Set Rng = .Find(What:=FindString, _
                   After:=Rng, _
                   LookIn:=xlValues, _
                   LookAt:=xlWhole, _
                   SearchOrder:=xlByRows, _
                   SearchDirection:=xlNext, _
                   MatchCase:=False)
         If Rng.Address = Rng0.Address Then Set Rng = Nothing
      Wend

   End With
End If

End Sub