时间戳

首页 > 解决方案 > 如何从剪切/删除/粘贴已在同一工作表中剪切/删除/粘贴的行中停止 Find if Then 功能

excel - 如何从剪切/删除/粘贴已在同一工作表中剪切/删除/粘贴的行中停止 Find if Then 功能

问题描述

我修改了下面的代码，以便根据列中的特定值将整行剪切并粘贴到 SAME 表中的较低位置。这些行不是粘贴在最后一行，而是粘贴在有数据的行之间的几个空行中。假设我有 12 行需要复制并粘贴到数据之间的 12 个空行中。下面的代码将首先将行移动到 12 个空行，然后继续移动已经移动到所有行末尾位置的大约 6 行。移动 12 行后如何让代码停止？

Sub MoveLS()

    Dim i As Variant
    Dim endrow As Integer
    Dim Version3 As Worksheet

    Set Version3 = ActiveWorkbook.Sheets("Version 3")

    endrow = Version3.Range("A1").End(xlDown).Offset(1, 0).Row

    For i = 2 To endrow
        If Version3.Cells(i, "AVI").Value = "3. NOT ON LIST" Then
            Version3.Cells(i, "AVI").EntireRow.Cut Destination:=Version3.Range("A1").End(xlDown).Offset(1, 0)
            Version3.Cells(i, "AVI").EntireRow.Delete
        End If
    Next

End Sub

标签： excelvba

解决方案

这是一种方法：在完成循环之前不要删除行。

Sub MoveLS()

    Dim i As Variant
    Dim endrow As Integer
    Dim Version3 As Worksheet
    Dim rngDel As Range

    Set Version3 = ActiveWorkbook.Sheets("Version 3")

    endrow = Version3.Range("A1").End(xlDown).Row 'removed the Offset(1, 0)
    For i = 2 To endrow
        If Version3.Cells(i, "AVI").Value = "3. NOT ON LIST" Then

            Version3.Cells(i, "AVI").EntireRow.Cut _
                    Destination:=Version3.Range("A1").End(xlDown).Offset(1, 0)
            'add a dummy value so the next xlDown doesn't stop here
            Version3.Cells(i, "A").Value = "XXX" 

            'build range to delete later
            If rngDel Is Nothing Then
                Set rngDel = Version3.Cells(i, "AVI")
            Else
                Set rngDel = Application.Union(rngDel, Version3.Cells(i, "AVI"))
            End If
        End If
    Next

    'delete any cleared rows
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete

End Sub

推荐阅读