Excel VBA: если ячейка содержит определенный текст, введите диапазон ячеек с этим содержимым

Question

Хотелось бы, чтобы в диапазоне столбцов производился поиск определенного текста («ПРИЧИНА»), а при обнаружении, чтобы все содержимое ячейки было заполнено в диапазоне разных ячеек.

Это делается до тех пор, пока не будет найден новый «REASON» - в этом случае содержимое этой ячейки будет скопировано соответствующим образом, как и раньше.

Это результат до: перед

... и ожидаемый результат с заполненным текстом в столбце J

Спасибо, ребята, возился с этим, но не уверен, куда идти:

Sub AddSus()
Dim SrchRng As Range, cel As Range
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
  If InStr(1, cel.Value, "REASON") > 0 Then
     cel.Offset(1, 0).Value = cel.Value
  End If
Next cel
End Sub

Answer 1

Есть несколько вещей не так с этим.Когда вы выполняете итерацию по cel in SrchRng, ваше условие проверяет значение этого cel на наличие «REASON».Это не то, что вы хотите.По сути, вы проверяете строку «REASON» и говорите, что все записи ниже этого, до следующей причины, должны быть истинными для условного заполнения столбца J.

Позволяет, действительно вкратце, рассмотрим логику отдельной ячейки, чтобы проиллюстрировать, почему ваш код не выполняет то, что вам нужно: в ячейке G3 вы проверяете, содержит ли она строку «REASON».Это не так, поэтому нигде не присваивается никакого значения.Следующее будет делать то, что вы хотите:

Sub AddSus()
Dim SrchRng As Range, cel As Range, reasonString As String
Set SrchRng = Range("g1:g60")
For Each cel In SrchRng
    If InStr(1, cel.Value, "REASON") > 0 Then
        reasonString = cel.Value
    ElseIf cel.Value <> "" Then
        cel.Offset(0, 3).Value = reasonString
  End If
Next cel
End Sub

Незначительное примечание, но если вы находитесь в столбце G и хотите заполнить столбец J, смещение должно быть .offSet(0,3).

Answer 2

Быстрое и грязное решение ...

Sub AddSus()

    Dim SrchRng As Range, cel As Range
    Dim reason As String

    Set SrchRng = Range("g1:g60")

    For Each cel In SrchRng

        If InStr(1, cel.Value, "REASON") > 0 Then
            reason = cel.Value
        End If

        If cel.Column = 10 And Len(cel.Offset(,-1)) > 0 Then
            cel.Value = reason
        End If

    Next

End Sub

Answer 3

Используйте НАЙТИ для быстрого перехода между экземплярами ПРИЧИНА :

Sub AddSus()

    Dim SrchRng As Range
    Dim rFound As Range
    Dim lStart As Long, lEnd As Long
    Dim sFirstAddress As String
    Dim sReason As String

    Set SrchRng = ThisWorkbook.Worksheets("Sheet1").Range("G:G")

    'Find the first instance of REASON in column G.
    Set rFound = SrchRng.Find(What:="REASON:", _
                       After:=SrchRng.Cells(1, 1), _
                       LookIn:=xlValues, _
                       LookAt:=xlPart, _
                       SearchOrder:=xlByRows, _
                       SearchDirection:=xlNext, _
                       MatchCase:=True)

    'Check something has been found before continuing.
    If Not rFound Is Nothing Then

        'Find just keeps looping unless you tell it to stop,
        'so record the first found address.
        sFirstAddress = rFound.Address
        Do
            'Save the reason and start row.
            sReason = rFound.Value
            lStart = rFound.Row

            'Find the next REASON in column G.
            Set rFound = SrchRng.FindNext(rFound)

            If rFound.Address = sFirstAddress Then
                'The first instance has been found again, so use column I to find last row of data.
                lEnd = SrchRng.Offset(, 2).Cells(Rows.Count, 1).End(xlUp).Row
            Else
                lEnd = rFound.Row
            End If

            'Fill in from 2 rows down from Start and 2 rows up from End.
            'This will go wrong if there's not enough space between REASONs.
            With ThisWorkbook.Worksheets("Sheet1")
                .Range(.Cells(lStart + 2, 10), .Cells(lEnd - 2, 10)) = sReason
            End With

        Loop While rFound.Address <> sFirstAddress
    End If

End Sub