Question

这是较大代码的一小部分。基本上如果单元格包含单词continue，我需要查看上面的单元格，如果此单元格包含单词continue，那么我需要继续循环行直到找到未继续的值。这是我到目前为止所拥有的？

      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将出现在单元格中，您必须参考上面单元格中的信息。然而，为了汇总数据，我需要实际的信息而不是单词继续。我试图让代码找到这些信息，但我正在努力。

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

Answer 1

要向后循环，您可以使用带step - 1的for循环。

您需要知道您开始的最低行是什么。如果它只是列中的最后一行，您可以使用它。

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

Answer 2

这应该有用......

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

循环行直到值不等于续

2 个答案: