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

debugcn 发表于 Dev

野蛮人

因此，我可以搜索，但是循环遇到问题，这是一些上下文的示例：

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在一行上，则将该行（从A：F）复制并粘贴到从第5行开始的Sheet3中。
跳过该行的其余部分，并在DCCUEQ上搜索下一行，然后
检查是否粘贴到先前粘贴的行（在Sheet3上）下满足要求将其
循环，直到连续未找到任何信息

它是一个大型程序的一部分，因此，如果我可以在填充这部分代码方面获得一些帮助，那么我可以按照逻辑很轻松地完成其余部分

请提供任何帮助或指导信息，以帮助我解答。

里德

坚持使用查找，因为您可能要复制格式。注意Rng0是为了防止当find重新回绕时出现无限循环。

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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。