Excel VBA查询关于查找特定单词，插入一行，并粘贴到所述行中

Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False If Target.Cells.Count > 1 Then Exit Sub Dim OutputFile As Workbook Dim Inputpath As String Dim Outputpath As String Dim del1 As Variant If Not Intersect(Target, Range("G:G")) Is Nothing Then Application.ScreenUpdating = False Set InputFile = ActiveWorkbook Set OutputFile = Workbooks.Open("\\SHKFS1\Shared\MONAHAN\1st watch files\inst status sheet\STATUSSHEETINSTITUTIONAL.xlsm") del1 = Target.Offset(0, -5).Value If Target.Validation.Type = 3 Then If Target.Value = "" Then OutputFile.Sheets("UI").Cells.Find(del1, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).EntireRow.Delete Else OutputFile.Sheets("UI").Cells(Rows.Count, 1).End(xlUp)(2).Resize(, 2) = Target.Offset(, -5).Resize(, 2).Value OutputFile.Sheets("UI").Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = Target.Value OutputFile.Sheets("UI").Cells(Rows.Count, 1).End(xlUp).Offset(, 4).FormulaR1C1 = "Monahan" End If OutputFile.Close savechanges:=True End If Application.ScreenUpdating = True End If End Sub 

我希望能够find单词“用户界面”，并在其下面插入一行，并将上面的信息（在代码中的“Else”之后）粘贴到插入的行中。 同样的事情将是“LOP”。

UI

梁，吉姆123456

琼斯，吉姆123456

LOP

戴维斯，贝蒂456789

裂纹，唐纳德456789

Answer 1

你可能会在这之后：

  ... Else Dim f As Range With OutputFile.Sheets("UI") Set f = .Range("A1", .Cells(.Rows.count, 1).End(xlUp)).Find(what:="UI", lookat:=xlWhole, LookIn:=xlValues) End With If Not f Is Nothing Then Application.EnableEvents = False f.Offset(1).EntireRow.Insert f.Offset(1).Resize(, 3) = Array(Target.Offset(, -5).Resize(, 2).Value, Target.Value, "Monahan") Application.EnableEvents = True End If End If ...