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

我希望能夠找到單詞「UI」並在其下面插入一行並粘貼上面的信息（在代碼中的「Else」）插入到插入的那一行中。「LOP」也是一樣。Excel VBA查詢查找特定單詞，插入一行，並粘貼到所述行中

梁，吉姆123456

瓊斯，吉姆123456

LOP

戴維斯，貝蒂456789

裂紋，唐納德456789

來源

2017-03-05 Eric Miller

'Application.ScreenUpdating = False'非常適合讓您的代碼在沒有屏幕閃爍的情況下運行得更快。當代碼運行不正常時，這是一場噩夢。評論它，直到事情正確。你的代碼在做什麼或者不在做什麼？你有錯誤嗎？幫助我們幫助你。 – FreeMan

另外，你只需要一次'Application.ScreenUpdating = False'（你有兩次），你的'Application.ScreenUpdating = True'是有條件的 - 如果你沒有進入第一個'If'，，你會離開'ScreenUpdating'關閉。將它移動到'End Sub'之前 – FreeMan

，你是後這個：

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

來源

2017-03-05 01:38:43 user3598756

@EricMiller，你通過了嗎？ – user3598756

Excel VBA查詢查找特定單詞，插入一行，並粘貼到所述行中

回答

相關問題