VBA：搜索，复制，插入行，粘贴和引导值

Question

请帮助VBA代码。我是VBA新手，正如你从我的代码中看到的那样。

我试图创建一个宏，它会找到一个值“PLGDY”，那么它应该从这一行复制数据，在这个找到的上面插入一个新行，将数据粘贴到新行中，替换值“PLGDY”与“PLGDN”。 我写了一个宏，但它不能正常工作。而不是将数据复制到新行，它将i粘贴到右侧的单元格中。它也将两行中的值更改为“PLGDN”。

我也想使用For Next循环，因为我有很多值要改变。是否有可能检查工作表中有多少值要更改？因为我想用这个数字作为计数器。

Sub Find_and_Change() 
' 

'Find a "PLGDY" and set an active cell 
Cells.Find(What:="PLGDY", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ 
     :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
     False, SearchFormat:=False).Activate 

'select a block of data in a row 
     Range(Selection, Selection.End(xlToRight)).Select 
     Range(Selection, Selection.End(xlToLeft)).Select 
     Range(Selection, Selection.End(xlToLeft)).Select 
     Range(Selection, Selection.End(xlToLeft)).Select 
'copy selected block of data 
     Selection.Copy 
'insert a row above active cell 
     ActiveSheet.Cells(ActiveCell.Row, 1).Select 
     ActiveCell.EntireRow.Insert 
'set an active cell at the beginig of a row and move into column A 
     ActiveSheet.Cells(ActiveCell.Row, 1).Select 
' paste copied data into this cell 
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
     :=False, Transpose:=False 
'Now I select whole row 
     ActiveCell.EntireRow.Select 
'I need to replace PLGDY with PLGDN in this row 
Selection.Replace What:="PLGDY", Replacement:="PLGDN", LookAt:=xlPart, _ 
     SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False 
'I need to move active cell 10 columns right and one row down because I want to find next PLGDY 
     ActiveCell.Offset(1, 10).Select 

End Sub 

感谢您的帮助。

Answer 1

你是新的我明白你可能不知道所有的快捷方式和内置函数。我仍然一直在学习新的东西。在这种情况下，我使用内置的工作表函数CountIf来获取值出现的次数。然后遍历我喜欢用Do Until Loop，只是减去1通过每个循环，直到我达到0.1

Sub Find_and_Change() 


vCount = Application.WorksheetFunction.CountIf(Range("A1:Z100"), "PLGDY") 

Do Until vCount = 0 

    Cells.Find(What:="PLGDY", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ 
      :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
      False, SearchFormat:=False).Activate 

    ActiveCell.EntireRow.Copy 
    ActiveCell.EntireRow.Insert 

    Selection.Replace What:="PLGDY", Replacement:="PLGDN", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
    ReplaceFormat:=False 

    ActiveCell.Offset(1, 10).Select 
    vCount = vCount - 1 

Loop 

End Sub 

Answer 2

mrbungle的答案是当场上！很棒。

对于任何人发现这一点，并打算使用此代码复制具有多个值的行，有一个调整。 我能够复制/粘贴循环并更改变量以适应，只有例外是我需要在ActiveCell.EntireRow.Insert之后添加ActiveCell.EntireRow.Select，否则当第二个循环通过新值取代原始值和新行时没有被选中。更新的代码我的目的是：

Private Sub LT2V() 

Dim vCount As Integer 

'Add Lesser tier of 2V 
vCount = Application.WorksheetFunction.CountIf(Range("D:D"), "2V") 

Do Until vCount = 0 
Cells.Find(What:="2V", After:=ActiveCell, LookIn:=xlFormulas, LookAt _ 
     :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _ 
     False, SearchFormat:=False).Activate 

ActiveCell.EntireRow.Copy 
ActiveCell.EntireRow.Insert 
ActiveCell.EntireRow.Select 

Selection.Replace What:="2V", Replacement:="1V", LookAt:=xlPart, _ 
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
ReplaceFormat:=False 

ActiveCell.Offset(1, 10).Select 
vCount = vCount - 1 
Loop 

End Sub