/ / Pesquisar cada linha, cole cada correspondência - Excel VBA - excel, vba

Pesquise cada linha, cole cada correspondência - Excel VBA - excel, vba

Então eu posso pesquisar, mas estou tendo problemas com o loop, aqui está um exemplo para algum contexto:

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

Há algumas coisas que preciso fazer com isso

Se FindString estiver em uma linha, copie e cole essa linha (de A: F) para Sheet3 a partir da linha 5
Pule o resto da linha e procure a próxima linha no DCCUEQ
verifique e cole sob a linha colada anteriormente (na Planilha3) se os requisitos forem atendidos
Faça um loop até que nenhuma informação seja encontrada em uma linha

Faz parte de um programa grande, então, se eu puder obter uma pequena ajuda para preencher essa parte do código, posso fazer o resto com bastante facilidade, seguindo a lógica

Qualquer ajuda ou direção para a informação para me ajudar em uma resposta seria apreciada por favor.

Respostas:

2 para resposta № 1

Furar com Find desde que você pode querer copiar formatos. Nota Rng0 é evitar um loop infinito quando o find volta.

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

3 para resposta № 2

Eu acho que usar 2 loops For (um para as colunas e um para as linhas) funcionaria perfeitamente no seu contexto.

Você define uma célula com suas duas variáveis ​​para o endereço e a compara à sua string. Se for o mesmo, copie / cole e saia do loop de colunas para pular o restante da linha.

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

Deixe-me saber se esse jeito combina com você.