Question

我花了一些时间尝试让我的代码工作并查看各种示例，但仍然无法使其正常工作。

我有一个表格，我想循环遍历所有行，如果＆＃34; Pro＆＃34;在B列中找到，复制整行并将其粘贴到行下方或最底部（理想情况下）（代码前后附加图片）

我尝试使用下面的代码，但它所做的就是找到＆＃34; Pro＆＃34;的第一个实例。在B列中并复制同一行，直到范围50到达：

sub Loop()
Dim i As Long
For i = 1 To 50
Range("B" & i).Select
If Range("B" & i).Value = "Pro" Then      
Rows(i).EntireRow.Copy
Rows(i + 1).Insert Shift:=xlDown

End If
 Next i
End Sub

我试过（For i = 1 To Cells（Rows.Count，1）.End（xlUp）.Row）同样，定义最后一列，但同样的事情发生（最后一遍又一遍地复制相同的行，直到完成指定的范围）。

如果这太容易了，我希望复制的行在A列中的值也可以从Req2改为Req2Pro

https://i.stack.imgur.com/AnWNH.jpg

Answer 1

编辑此行：

Rows(i).EntireRow.Copy
Rows(i + 1).Insert Shift:=xlDown

使用：

Rows(i + 50).Value = Rows(i).Value
Range("A" & i + 50).value =  Range("A" & i).value & "Pro"

这是代码：

 Sub testloop()
 Dim i As Long
 Dim Find_last_row as long
 Find_last_row = cells(rows.count,1).end(xlup).row

 For i = 1 To Find_last_row
    If Range("B" & i).Value = "Pro" Then
       Rows(i + Find_last_row).Value = Rows(i).Value
       Range("A" & i + Find_last_row).value =  Range("A" & i).value & "Pro"
    End If
 Next i
 End Sub

Answer 2

运行for-next循环降序，例如

for row = 50 to 1 step -1
    ...
   .cells(row+1,1)=.cells(row,1) & "Pro"
next

问题是它找到了一个“Pro”并向下插入一行副本，然后推进行计数器并找到副本。从底部向上运行，创建的行已经传递

已编辑以添加列A更新

Sub Loop()
    Dim i As Long
    For i = 50 To 1 step -1
        Range("B" & i).Select
        If Range("B" & i).Value = "Pro" Then
            Rows(i).EntireRow.Copy
            Rows(i + 1).Insert Shift:=xlDown
            Range("A" & i + 1).Value = Range("A" & i).Value & "Pro"
        End If
    Next i
End Sub

编辑添加以上

如果找到值，则遍历行，复制整行并粘贴到下/下行

2 个答案: