向上循环行，直到值不等于继续 [英] Loop Up rows until Value DOES NOT equal Continued

问题描述

这是较大代码的一小部分.基本上，如果该单元格包含继续"一词，我需要在上面的单元格中查找，如果该单元格包含继续"一词，那么我需要继续循环行，直到找到不连续的值.这就是我到目前为止所拥有的?

This is a small section of a larger code. basically if the cell contains the word continued I need to look in the cell above, if this cell contains the word continued then I need to continue to loop up the rows until a value which is not continued is found. This is what I have so far ?

      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."

上面的代码是该代码的一小部分，该代码用于搜索故障模式和原因.但是，有时在源数据中重复相同的值.在这种情况下，继续"一词会出现在单元格中，您必须参考上面单元格中的信息.但是，出于合并数据的目的，我需要实际信息，而不是继续"一词.我正在尝试让代码找到这些信息，但是却很挣扎.

The code above is a smaller part of this code the code is to search for failure mode and causes. However in the source data sometimes the same value is repeated. in this case the word continued appears in the cell and you must refer to the information in the cell above. However for the purposes of coalating the data i need the actual information not the word continued. im trying to make the code find this information but am struggling.

Sub Create_FHA_Table()
    Dim Headers() As String: Headers = _
    Split("FHA Ref,Engine Effect,Part No,Part Name,FM I.D,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

并添加更多搜索词，将主代码循环替换为以下代码...

And to add in further search terms replace the main code loop with the following code...

    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，以便与第一个代码块略有不同

You'll need to edit the array for your terms though, delimiting each with a comma... I've also tweaked the loop variables to be i,j,k in order so there's a slight difference to the first code block

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

这篇关于向上循环行，直到值不等于继续的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！