Как выбрать прецеденты и строки потомков на основе строки поиска.- X

Question

Я не новичок в Excel VBA, но и не эксперт.У меня странная проблема, кто-то, пожалуйста, помогите мне, я больше не могу думать.

Моя история Excel: у меня около 40 000 строк в электронной таблице.строки в шаблоне, указанном ниже:

row1) Source> AppName1

row2) Destination> соответствующее значение1

row3) Destination> соответствующее значение2

row4) Source> AppName2

row5) Destination> соответствующее значение3

row6) Source> AppName3

row7) Destination> соответствующее значение1

Теперь, если поиск по AppName будет AppName1, то row2 и row3 должны быть скопированы на следующий лист вместе с row1.Если я ищу Value1, то получим, что row1, row2, row3, row7 и row6 должны быть скопированы на следующий лист.Это означает, что прецеденты строк поиска и строки потомков должны быть скопированы на следующий лист.

Я не могу предоставить образец листа, так как мои очки репутации меньше 10.

Есть ли кто-нибудь, кто может мне помочь и помочь, я потратил 3 дня на это, но не получил никакого результата.У меня есть очень критический график для подготовки этого инвентарного листа, я делал это вручную, и это занимало 5-6 дней, чтобы сделать это вручную.Я думал об автоматизации этого, но застрял.

Вот мой код, который не работает:

Sub GenerateInventory()
On Error GoTo ErrHandler:
Set r = ActiveSheet.UsedRange
nLastRow = r.Rows.Count + r.Row - 1
Set r1 = Cells(2, 8)
For i = 2 To nLastRow Step 1
If InStr(Cells(i, 6), "CMRI") <> 0 Then
Set r1 = Union(r1, Cells(i, 1))
End If
Next
r1.EntireRow.Select
r1.EntireRow.Copy
Sheets("MS4Inventory").Select
Cells(100, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Exit Sub
ErrHandler:
MsgBox Err.Number & ": " & Error.Description

End Sub

Этот код не соответствует действительности до сих пор в WIP.

Answer 1

перед тем, как перейти к кодированию, давайте разберемся с проблемой ....

вы хотите найти что-нибудь на листе и вернуть три строки, которые принадлежат «абзацу», в который попал ваш поиск

Исходя из предположения, что ВСЕ абзацы являются тройками, все строки, отмечающие начало «абзаца», имеют одно и то же свойство: rownumber по модулю 3 имеет одинаковое постоянное значение.Таким образом, в каком бы числовом числе ни находились ваши искомые земли, вам нужно возвращаться, пока числовое значение по модулю 3 не станет равным вашему постоянному значению.Прибыв туда, вы проигрываете 3 строки - и останавливаетесь

, теперь кодирование должно стать довольно простым .... вы запускаете поиск или устанавливаете курсор «где-то» другими средствами и запускаете Sub Grab()

Sub Grab3Rows()
Dim Idx As Long
    Idx = Selection.Row

    'find start of paragraph
    Do While Idx Mod 3 <> 2 ' change this constant as per your sheet
        Idx = Idx - 1
    Loop

    'select the 3 cells at the start of paragraph
    Selection.Offset(Idx - Selection.Row, 0).Resize(3, 1).Select

    'do the rest
End Sub

Исходя из предположения, что параграфы являются n-кортежами и содержат строку «Источник» в первой строке, вы можете сделать что-то похожее: где бы вы ни находились, вы возвращаетесь строка за строкой, пока не достигнетестрока, содержащая строку «Источник», оттуда вы воспроизводите строки, пока не доберетесь до строки, содержащей «Источник»

Sub GrabByTextString()
Dim Idx As Long
    Idx = Selection.Row

    'find start of paragraph
    Do While Left(Selection.Offset(Idx - Selection.Row, 0), 6) <> "Source"
        Idx = Idx - 1
    Loop

    'select the the start of paragraph
    Selection.Offset(Idx - Selection.Row, 0).Select

    'expand selection until we reach next paragraph start
    Idx = 1

    Do While Left(Selection(1, 1).Offset(Idx, 0), 6) <> "Source"
        Idx = Idx + 1
        Selection.Resize(Idx, 1).Select
    Loop

    'do the rest
End Sub

Answer 2

Данные и требования вашего примера сложны для понимания.

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

Sub GenerateInventory()
    Dim r As Range, r1 As Range, rMS4Inventory As Range
    Dim nLastRow As Long, i As Long
    Dim wb As Workbook, sh As Worksheet, shMS4Inventory As Worksheet

    On Error GoTo ErrHandler:

    Set wb = ActiveWorkbook
    Set sh = wb.ActiveSheet
    Set shMS4Inventory = wb.Worksheets("MS4Inventory")

    Set r = sh.UsedRange
    nLastRow = r.Rows.Count + r.Row - 1
    Set r1 = sh.Cells(2, 8)
    For i = 2 To nLastRow Step 1
        If InStr(sh.Cells(i, 6), "CMRI") <> 0 Then
            Set r1 = Union(r1, sh.Cells(i, 1))
        End If
    Next
    Set rMS4Inventory = shMS4Inventory.Cells(100, 1).End(xlUp).Offset(1, 0).EntireRow
    r1.EntireRow.Copy rMS4Inventory
Exit Sub
ErrHandler:
    Resume
    MsgBox Err.Number & ": " & Error.Description

End Sub