Найти число в столбце, вставить строку под столбцом, заполнить данными и повторять до тех пор, пока не будут найдены все предварительно определенные числа

Question

Мне нужно найти значение «5005» (только это значение) в столбце J: J, вставить новую строку под ним, а затем заполнить строку значениями в столбцах A-U.

Я новичок в VBA, и я не могу сделать это, не испортив код.

Черновик будет выглядеть примерно так

Найти все ячейки со значением 5005 в столбце J: J, Вставьте строку ниже, Поместите значение 1 в А, Поместите Value2 в B, и т.д .... до столбца U, Повторите для следующей ячейки, в которой есть «5005», пока не будет больше

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

В грязном коде, который я предоставил ниже, я смог найти значение «5005» и вставить строку под ним, но любая ячейка, которую я выбрал в excel, будет заполнена значением «ИСТИНА» и кодом довольно грязный Не уверен, правильно ли я шел с ним.

Sub AAAAAAAtest()
    Dim find5005 As Range

    'Have excel search 1 column instead of all cell
    Set find5005 = Cells.Find(What:="5005", LookIn:=xlFormulas, _
                              LookAt:=xlPart, SearchOrder:=xlByColumns, _
                              SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)

    If find5005 Then ActiveCell.Value = find5005.Offset(1).EntireRow.Insert
End Sub

Answer 1

Повествование в коде комментария

Option Explicit

Sub insert5005()

    Dim rng As Range, urng As Range, faddr As String
    Dim vals As Variant

    'get some dummy values quickly
    vals = buildAU()

    With Worksheets("sheet5")

        'find first 5005
        Set rng = .Range("J:J").Find(What:="5005", after:=.Cells(.Rows.Count, "J"), _
                                     LookIn:=xlFormulas, LookAt:=xlPart, _
                                     SearchOrder:=xlByRows, SearchDirection:=xlNext)

        'continue if found
        If Not rng Is Nothing Then

            'record first found cell
            faddr = rng.Address

            'start loop for insert, populate and additional cells
            Do
                'insert new row
                rng.Offset(1, 0).EntireRow.Insert
                'populate row
                .Cells(rng.Offset(1, 0).Row, "A").Resize(1, UBound(vals) + 1) = vals
                'look for another
                Set rng = .Range("J:J").FindNext(after:=rng)

            'keep going until first address is reached a second time
            Loop Until rng.Address = faddr

        End If

    End With

End Sub

Function buildAU()

    'construct some dummy values

    Dim i As Long, tmp As String

    For i = 65 To 85
        tmp = tmp & Format(i, "|v\alu\e00")
    Next i

    buildAU = Split(Mid(tmp, 2), Chr(124))

End Function