Question

所以我有一个我编写的代码，代码的第一部分是创建一个带有指定标题的新工作表。代码的第二部分是用某些信息填充该表。我遇到的问题是获取正确的信息位以进入正确的列。我需要代码在工作簿中的所有工作表中搜索G列中的值9.1 如果找到该值，我需要将其复制到新表中的b列以及以下信息：

列F的引擎效果必须将相同的行粘贴到名为FHA的工作表中的C列部件号始终位于Cell J3中，必须将其粘贴到D列中并始终相同零件名称始终位于C2中，必须粘贴到E列中并始终相同必须将来自B列相同行的FM ID粘贴到名为FHA的工作表中的F列失败模式＆amp; C列的原因必须将相同的行粘贴到FHA中的G列 N列中的FMCN值粘贴到FHA中的H列

因为它代表我的代码是

Sub createWSheetFHA()
    Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "FHA"

    Cells(1, 2) = "FHA TABLE"
    Cells(2, 2) = "FHA Ref"
    Cells(2, 3) = "Engine Effect"
    Cells(2, 4) = "Part No"
    Cells(2, 5) = "Part Name"
    Cells(2, 6) = "FM I.D"
    Cells(2, 7) = "Failure Mode & Cause"
    Cells(2, 8) = "FMCM"
    Cells(2, 9) = "PTR"
    Cells(2, 10) = "ETR"

    Range(Cells(2, 2), Cells(2, 10)).Font.Bold = True
    Range(Cells(1, 2), Cells(1, 10)).MergeCells = True
    Range(Cells(1, 2), Cells(1, 10)).Font.Bold = True

End Sub
Sub Populate_FHA_Table_2()
    Dim wks As Excel.Worksheet, i As Integer, n As Integer
    Application.ScreenUpdating = False
    Sheets("FHA").Range("A2:" & Columns.Count & ":" & Rows.Count).Delete
    i = 1
    For Each wks In ActiveWorkbook.Worksheets
        If wks.Name <> "FHA" Then
            wks.UsedRange.AutoFilter Field:=7, Criteria1:="9.1"
            Sheets(i).Range(Sheets(i).Range("G1").Offset(1), Sheets(i).Range("B1").End(xlDown)).Copy _
                Sheets("FHA").Range("C" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("F1").Offset(1), Sheets(i).Range("D1").End(xlDown)).Copy _
                Sheets("FHA").Range("d" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("J1").Offset(1), Sheets(i).Range("E1").End(xlDown)).Copy _
                Sheets("FHA").Range("e" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("C1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("FHA").Range("E" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("B1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("FHA").Range("F" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("C1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("FHA").Range("G" & Rows.Count).End(xlUp)
            Sheets(i).Range(Sheets(i).Range("N1").Offset(1), Sheets(i).Range("H1").End(xlDown)).Copy _
                Sheets("FHA").Range("H" & Rows.Count).End(xlUp)
            wks.UsedRange.AutoFilter
        End If
    i = i + 1
    Next
    Application.ScreenUpdating = True

End Sub

Answer 1

您的代码中存在一些不匹配（示例使用＆＃39;对于每个wk＆＃39;然后通过索引访问＆＃39; i＆＃39;;它们可能不一定匹配）

尝试这样的事情......

我已经添加了一些动态流量控制，这是非常严格需要的，但如果您的标题在将来发生变化，那么以这种形式提供它可能会更容易。

同样，我也尝试添加一些错误处理

Sub Create_FHA_Sheet()
    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: SearchTarget = "9.1"
    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)
            If Not SourceCell Is Nothing Then
                FirstAdr = SourceCell.Address
                Do
                    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
                    wsFHA.Cells(RowCounter, 7).Value = .Cells(SourceCell.Row, 3).Value
                    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
End Function

搜索功能需要帮助编辑

1 个答案: