Question

这段代码我似乎只复制，粘贴和删除其他所有行。我对任何想法都失去了意见吗？

Dim c As Long, rG As Range, vR As Variant
c = 1000
Dim wsA As Worksheet, wsC As Worksheet
Set wsA = Sheets("Active")
Set wsC = Sheets("Closed")
wsA.Activate
For Each rG In Intersect(Range("Y:Y"), ActiveSheet.UsedRange)
    vR = rG.Value
    If InStr(vR, "Yes") > 0 Then
        rG.EntireRow.Copy wsC.Cells(c, 1)
        rG.EntireRow.Delete
        c = c + 1
    End If
Next rG

我C = 1000的唯一原因是因为我不知道如何将其插入表格（＆＃34;已关闭＆＃34;）第一个空单元格末尾的A列。我宁愿这样做，因为一旦我们有其他1000个单元填充我的代码，开始替换单元格A1000。

感谢任何帮助人员

Answer 1

类似的东西：

For i = ActiveSheet.Range("Y" & Rows.Count).End(xlUp).Row to 1 step -1
    set rG = Range("Y" & i)
    vR = rG.Value
    If InStr(vR, "Yes") > 0 Then
        rG.EntireRow.Copy wsC.Cells(c, 1)
        rG.EntireRow.Delete
        c = c + 1
    End If
Next i

您还可以使用Rows.Count

修复c的值

Answer 2

如果将行删除添加到特殊范围内，则无需向后退一步。完成循环后，只需删除我们称之为delRng的整个特殊范围。

Dim c As Long, rG As Range, vR As Variant, delRng As Range '<-- New Variable Declaration
c = 1000
Dim wsA As Worksheet, wsC As Worksheet
Set wsA = Sheets("Active")
Set wsC = Sheets("Closed")
wsA.Activate
For Each rG In Intersect(Range("Y:Y"), ActiveSheet.UsedRange)
    vR = rG.Value
    If InStr(vR, "Yes") > 0 Then
        If delRng Is Nothing Then  '<-- Don't use union() if delRng Is Nothing
            Set delRng = rG.EntireRow
        Else
            Set delRng = Union(delRng, rG.EntireRow)
        End If
        rG.EntireRow.Copy wsC.Cells(c, 1)
        c = c + 1
    End If
Next rG

' Delete your delRng - after you finish looping
If Not delRng Is Nothing Then delRng.Delete

您甚至可能会注意到性能提升，因为不能一次删除这些范围，而是一次性删除这些范围。

如需进一步了解Union()方法的使用情况，请see here。

粘贴到新工作表后删除选择，粘贴到列中的第一个可用单元格

2 个答案: