Loop Up rows до тех пор, пока значение не будет равно. Продолжение

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

Do If .Cells(SourceCell.Row, 3).Value = "continued." Then wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Offset(rowoffset:=-1).Row, 3).Value End If Loop Until .Cells(SourceCell.Row, 3).Value <> "continued." 

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

 Sub Create_FHA_Table() Dim Headers() As String: Headers = _ Split("FHA Ref,Engine Effect,Part No,Part Name,FM ID,Failure Mode & Cause,FMCM,PTR,ETR", ",") If Not WorksheetExists("FHA") Then Worksheets.Add().Name = "FHA" Dim wsFHA As Worksheet: Set wsFHA = Sheets("FHA") wsFHA.Move after:=Worksheets(Worksheets.Count) wsFHA.Cells.Clear Application.ScreenUpdating = False With wsFHA For i = 0 To UBound(Headers) .Cells(2, i + 2) = Headers(i) .Columns(i + 2).EntireColumn.AutoFit Next i .Cells(1, 2) = "FHA TABLE" .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).MergeCells = True .Range(.Cells(1, 2), .Cells(1, UBound(Headers) + 2)).HorizontalAlignment = xlCenter .Range(.Cells(1, 2), .Cells(2, UBound(Headers) + 2)).Font.Bold = True End With Dim RowCounter As Long: RowCounter = 3 Dim SearchTarget As String 'must copy and paste between these bookmarks for each new code, "SearchTarget#" SearchTarget = "9.1" 'Must update SearchTarget# Dim SourceCell As Range, FirstAdr As String If Worksheets.Count > 1 Then For i = 1 To Worksheets.Count - 1 With Sheets(i) Set SourceCell = .Columns(7).Find(SearchTarget, LookAt:=xlWhole) 'Must Update SearchTarget# to correspond with above If Not SourceCell Is Nothing Then FirstAdr = SourceCell.Address Do wsFHA.Cells(RowCounter, 2).Value = SearchTarget 'Must Update SearchTarget# to correspond with above wsFHA.Cells(RowCounter, 3).Value = .Cells(SourceCell.Row, 6).Value wsFHA.Cells(RowCounter, 4).Value = .Cells(3, 10).Value wsFHA.Cells(RowCounter, 5).Value = .Cells(2, 10).Value wsFHA.Cells(RowCounter, 6).Value = .Cells(SourceCell.Row, 2).Value wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row, 3).Value If .Cells(SourceCell.Row, 3).Value = "continued." Then wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Offset(rowoffset:=-1).Row, 3).Value End If wsFHA.Cells(RowCounter, 8).Value = .Cells(SourceCell.Row, 14).Value Set SourceCell = .Columns(7).FindNext(SourceCell) RowCounter = RowCounter + 1 Loop While Not SourceCell Is Nothing And SourceCell.Address <> FirstAdr End If End With Next i End If Application.ScreenUpdating = True End Sub Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean On Error Resume Next WorksheetExists = (ThisWorkbook.Sheets(WorksheetName).Name <> "") On Error GoTo 0 

Это должно работать …

  For j = 0 To SourceCell.Row - 1 If .Cells(SourceCell.Row - j, 3).Value <> "continued." Then wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row - j, 3).Value Exit For End If Next j 

И чтобы добавить в дополнительные условия поиска, замените основной цикл кода следующим кодом …

  Dim SourceCell As Range, FirstAdr As String Dim RowCounter As Long: RowCounter = 3 Dim SearchTarget() As String SearchTarget = Split("9.1,SearchItem 2,etc...", ",") For i = 0 To UBound(SearchTarget) If Worksheets.Count > 1 Then For j = 1 To Worksheets.Count - 1 With Sheets(j) Set SourceCell = .Columns(7).Find(SearchTarget(i), LookAt:=xlWhole) If Not SourceCell Is Nothing Then FirstAdr = SourceCell.Address Do wsFHA.Cells(RowCounter, 2).Value = SearchTarget(i) wsFHA.Cells(RowCounter, 3).Value = .Cells(SourceCell.Row, 6).Value wsFHA.Cells(RowCounter, 4).Value = .Cells(3, 10).Value wsFHA.Cells(RowCounter, 5).Value = .Cells(2, 3).Value wsFHA.Cells(RowCounter, 6).Value = .Cells(SourceCell.Row, 2).Value For k = 0 To SourceCell.Row - 1 If .Cells(SourceCell.Row - k, 3).Value <> "continue." Then wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row - k, 3).Value Exit For End If Next k wsFHA.Cells(RowCounter, 8).Value = .Cells(SourceCell.Row, 14).Value Set SourceCell = .Columns(7).FindNext(SourceCell) RowCounter = RowCounter + 1 Loop While Not SourceCell Is Nothing And SourceCell.Address <> FirstAdr End If End With Next j End If Next i 

Вам нужно будет отредактировать массив для ваших терминов, разделив их запятой … Я также изменил переменные цикла, чтобы быть i, j, k, чтобы было небольшое отличие от первого кодового блока

  SearchTarget = Split("9.1,SearchItem 2,etc...", ",") 

Для обратной петли вы можете использовать цикл for с step - 1 .

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

 Dim lastRow As Long lastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, 1).End(xlUp).Row 

Затем вы переходите к самой высокой ячейке, у которой есть значения, и если это ваша первая строка, это будет 1:

 For i = lastRow To 1 Step -1 If .Cells(i, 1) <> "continue" Then ' Do things when the value doesn't equal continue here. Exit For End If Next i 
Давайте будем гением компьютера.