VBA - обновить функцию поиска, чтобы проходить по строкам и двигаться дальше, если значение отсутствует

Question

Попытка собрать макрос, который просматривает каждую строку, чтобы увидеть, содержит ли она 7 поисковых терминов (см. Пример «Гарантия:» ниже). Если ячейка начинается с одной из фраз (например, «Гарантия:»), то эта ячейка вставляется в определенную ячейку (в той же строке, но в другом столбце) на другом листе.

Проблемы:

• У меня были проблемы с макросом, пока я не добавил функцию выбора - я знаю, что это замедляет их, но я не мог найти способ сделать это без него
• Не могу понять, как заставить его пройти по всем строкам

• Ошибки, если в строке нет слова - нужно, чтобы они просто продолжали

  Sub FindTest()
  
   Worksheets("Macro").Range("1:1").Find(What:="Warranty: ", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True).Copy
  'Cell begins with "Warranty:" but text following varies
  
  Sheets("CSV Upload").Select
  Sheets("CSV Upload").Range("J1").Select
  ActiveSheet.Paste
  
  End Sub
  

ОБНОВЛЕНИЕ:

Sub FindTest()

Dim Macro As Worksheet: Set Macro = Sheets("Macro")
Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")

'On Error Resume Next
For R = 1 To Macro.UsedRange.Rows.Count
    Set rng = Macro.Rows(R)

Dim FindRange As Range: Set FindRange = rng.Find(What:="Warranty:", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)

'FindRange.Copy CSV.Range("J1")
'CSV.Cells(1, J) = Macro.Cells(FindRange)

Next

'On Error GoTo 0

End Sub

Answer 1

Чтобы пройти по каждой строке на рабочем листе:

Dim ws As Worksheet: Set ws = Sheets("Macro")
Dim csv_upload As workseet: Set csv_upload = Sheets("CSV Upload")

For r = 1 To ws.UsedRange.Rows.Count
    Set rng = ws.Rows(r)
    rng.Find(What:="Warranty: ", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)

    ...
Next

Затем скопировать значения, в зависимости от того, какие ячейки вам нужно скопировать

csv_upload.cells(dest_row, dest_col) = ws.cells(orig_row, orig_col)

Чтобы продолжить, если у вас есть ошибка, вы можете сказать, чтобы она возобновилась

On Error Resume Next
' potential for error to be raised
' Don't use this unless you know you are going to get a specific
' error and know there are no unintended consequences of ignoring it.
On Error GoTo 0

Используя код в вашем обновлении, следующий код должен работать для вас.

Sub FindWarranty()

    Dim Macro As Worksheet: Set Macro = Sheets("Macro")
    Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")
    Dim rng As Range, FindRange As Range
    Dim Phrase As String

    Phrase = "Warranty:"

    For r = 1 To Macro.UsedRange.Rows.Count

        Set rng = Macro.Rows(r)
        Set FindRange = rng.Find(What:=Phrase, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=True)

        If Not FindRange Is Nothing Then
            ' Set destination cell to what you need it to be
            c = 1
            CSV.Cells(r, c) = FindRange
        End If

    Next

End Sub

Несколько более элегантный способ, на который ссылается Quicksilver:

Sub FindWarrantys()

    Dim Macro As Worksheet: Set Macro = Sheets("Macro")
    Dim CSV As Worksheet: Set CSV = Sheets("CSV Upload")
    Dim FoundCell As Range, FirstAddr As String
    Dim Phrase As String, c As Integer

    Phrase = "Warranty:"

    ' Find the first occurrence. The after variable is set to the
    ' last cell so that it will start searching from the beginning.
    Set FoundCell = Macro.UsedRange.Find(what:=Phrase, _
        after:=Macro.UsedRange.Cells(Macro.UsedRange.Cells.Count))

    ' Save the address of the first occurrence to prevent an infinite loop
    If Not FoundCell Is Nothing Then
        FirstAddr = FoundCell.Address
    End If

    ' Loop through all finds
    Do Until FoundCell Is Nothing

        c = 1 ' Adjust for logic to determine which column
        CSV.Cells(FoundCell.Row, c) = FoundCell

        ' Find the next occurrence
        Set FoundCell = Macro.UsedRange.FindNext(after:=FoundCell)

        ' Break if we're back at the first address
        If FoundCell.Address = FirstAddr Then
            Exit Do
        End If

    Loop

End Sub