Как я могу вставить строки, основанные на содержимом ячеек, зацикленных на всех строках

Question

Я пытаюсь написать макрос, который приводит в порядок и запрашивает необработанные данные, экспортированные из некоторого аналитического инструментария. Я хотел бы, чтобы он просматривал один столбец (имена образцов) по всем строкам и искал индикаторы конкретных типов образцов, например, дубликатов. Находя эти индикаторы, я хочу вставить строку, и в новой вставленной строке выполнить несколько простых вычислений на основе двух строк выше. А пока я просто буду рад, когда вставка строк заработает.

Я могу заставить его найти ключевое слово и вставить 1 строку, но он находит первое и останавливается. В моих данных есть несколько экземпляров этих ключевых слов, и я хочу вставить строку под каждым

'original code - finds first keyword, inserts row and stops

Sub dup_finder()
    Dim colHeader As Range

    Set colHeader = Range("B1:B500")


Dim currCell As Range
Set currCell = Cells.Find("*_dup")

If Not currCell Is Nothing Then currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown


End Sub

'my attempt to include loop - inserts 500 rows below keyword! stops 
after first instance

Sub dup_finder()
Dim colHeader As Range
Dim row As Long
Dim currCell As Range

Set colHeader = Range("B1:B500")

Set currCell = Cells.Find("_dup")
        For row = 1 To 500
If Not currCell Is Nothing Then currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown

 Next row

End Sub

Answer 1

Я предлагаю всегда полностью квалифицировать свои диапазоны с помощью рабочей книги и листа.

Вы должны быть в состоянии приспособить это к тому, что вы хотите. Вы просто вводите диапазон, который вы хотите зарегистрировать, и значение, которое вы проверяете.

Он работает в обратном направлении, вверх по диапазону, вставляя строку под каждым найденным.

    Sub InsertRows()
        ''Declare your variables
        Dim RngToCheck As Range, ValToFind As String
        ''Set the range in which to look for your desired string.
        Set RngToCheck = ThisWorkbook.Sheets("Sheet1").Range("B1:B500")
        ''Set what string to look for.
        ValToFind = "_dup"

        ''Declare a variable to use as a counter
        Dim i As Long
        ''Count backwards through each of the rows in the range.
        ''(If you went forwards through the range, the rows you
        ''are inserting would become part of that range and push
        ''the bottom rows (which you intended to check) out of the range).
        For i = RngToCheck.Rows.Count To 1 Step -1
            ''Check if the last characters (the number of characters to
            ''check is defined by the length of the string we are looking
            ''for) of the current cell match the string we are looking for.
            If Right(RngToCheck(i).Value, Len(ValToFind)) = ValToFind Then
                ''Insert the row (we need to offset by 1 row
                ''because rows are inserted ABOVE, and we
                ''want it BELOW the current cell).
                RngToCheck(i).Offset(1, 0).EntireRow.Insert
                ''Now you can add your formulas to the new row...
                ''column A
                RngToCheck(i).Offset(1, -1).Formula = "=1+1"
                ''column B
                RngToCheck(i).Offset(1, 0).Formula = "=2+2"
                ''column C
                RngToCheck(i).Offset(1, 1).Formula = "=A" & RngToCheck(i).Offset(1, 1).Row & "+B" & RngToCheck(i).Offset(1, 1).Row
                ''column D
                RngToCheck(i).Offset(1, 2).Formula = "Hello"
                ''And so on...
            End If
        Next i
    End Sub

Answer 2

Если вы хотите вставить строку под каждым экземпляром ячейки в столбце B, содержащую "_dup", это должно сработать.

Проблема с вашим кодом заключалась в том, что он не зацикливался и поэтому всегданайден один экземпляр.

Желательно не указывать фиксированный диапазон при вставке строк, и диапазон будет расширяться;однако вы можете сделать это и установить направление поиска как «предыдущий».

Sub dup_finder()

Dim colHeader As Range, s As String

Set colHeader = Range("B1:B500") ' not actually used

Dim currCell As Range

'are we searching just B or the whole sheet?
Set currCell = Columns(2).Find(What:="_dup", Lookat:=xlPart, MatchCase:=False, SearchFormat:=False) 'change parameters to suit

If Not currCell Is Nothing Then
    s = currCell.Address             'store address of first found cell
    Do
        currCell.Offset(1, 0).EntireRow.Insert Shift:=xlDown
        Set currCell = Columns(2).FindNext(currCell)  'find next case
    Loop Until currCell.Address = s  'keep looping until we are back to the original case
End If

End Sub