search每一行，粘贴每个匹配 – Excel VBA

所以我可以search，但我有问题的循环，这是一些上下文的例子：

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
跳过该行的其余部分并searchDCCUEQ上的下一行
如果满足要求，检查并粘贴在以前粘贴的行（在Sheet3上）
循环播放，直到在一行中找不到任何信息

它是一个大型程序的一部分，所以如果我能够在填充这部分代码的过程中得到一些轻微的帮助，我可以很容易地遵循逻辑

任何帮助或方向的信息来帮助我的答案，将不胜感激。

Answer 1

坚持查找，因为你可能想复制格式。 注意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 

Answer 2

我认为使用2 For循环（一个用于列和一个用于行）将在您的上下文中完美工作。

你用你的两个地址variables来设置一个单元格，并将它与你的string进行比较。 如果相同，则复制/粘贴并退出列循环，以便跳过行的其余部分。

 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 

让我知道这种方式是否适合你。