Пошук по кожному рядку, вставлення кожного відповідника - Excel VBA - 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 знаходиться в рядку, скопіюйте та вставте цей рядок (від A: F) до Sheet3, починаючи з рядка 5
Пропустіть решту цього рядка та виконайте пошук у наступному рядку DCCUEQ
перевірити та вставити під раніше вставлений рядок (на Листі3), якщо вимоги виконуються
Перемістіть цю функцію, доки в рядку не буде знайдено жодної інформації

Це частина великої програми, тому, якщо я можу отримати невелику допомогу в заповненні цієї частини коду, я можу зробити все інше досить легко, дотримуючись логіки

Будь-яка допомога або напрямок інформації, щоб допомогти мені на відповідь буде оцінено, будь ласка.

Відповіді:

Залипання з 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

Я думаю, що використання 2 Для циклів (один для стовпців і один для рядків) буде відмінно працювати у вашому контексті.

Ви встановлюєте клітинку з двома змінними для адреси та порівнюєте її зі своїм рядком. Якщо це те ж саме, то скопіюйте / вставте і вийдіть з циклу стовпців, щоб він пропустив решту рядка.

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

Дайте мені знати, якщо вам це підходить.