excel - VBA损坏的复制粘贴循环

Question

我在工作簿中使用此代码有一段时间了，离开并回来重新访问，发现代码不再像以前那样运行。我看不到任何明显的错误，想知道是否有人能发现可能会阻止它运行的原因？

页面名称和位置保持不变。

目的是在工作表 4 (CAL) 中获取结果并将每一行复制到 RRR 中的新空行中。没有错误显示。只是什么都没有发生。

Sub ca_act()
    Dim nextrow As Long
    nextrow = Sheet4.Cells(4, "A").End(xlUp).Row + 1

    Dim src As Worksheet
    Set src = Sheets("CAL")

    Dim trgt As Worksheet
    Set trgt = Sheets("RRR")

    Dim i As Long
      For i = 1 To src.Range("y" & Rows.Count).End(xlUp).Row
        If src.Range("y" & i) = 1 Then
            ' calling the copy paste procedure
            CopyPaste src, i, trgt
        End If
    Next i
Application.ScreenUpdating = True
End Sub

' this sub copies and pastes the entire row into a different sheet
' below the last used row
Private Sub CopyPaste(ByRef src As Worksheet, ByVal i As Long, ByRef trgt As Worksheet)
    src.Activate
    src.Rows(i & ":" & i).Copy
    trgt.Activate
    Dim nxtRow As Long
    nxtRow = trgt.Range("y" & Rows.Count).End(xlUp).Row + 1
    trgt.Rows(nxtRow & ":" & nxtRow).PasteSpecial _
        Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Sub

标签： excelvbaloops

Answer 1

错误的工作表或列

一些猜测工作

以下行表示您将检查“A”列中的值

Dim nextrow As Long
nextrow = Sheet4.Cells(4, "A").End(xlUp).Row + 1

这可能是你的第一个想法。顺便说一句，您应该将其注释掉，因为它没用。

以后你写

For i = 1 To src.Range("Y" & Rows.Count).End(xlUp).Row

这意味着您正在检查“Y”列。您确定吗？

我会考虑以下几点：

• 您正在检查错误列中的值。
• 您的表格 CAL 和 RRR 可能是错误的，也许您已将名称 CAL 例如移动到没有数据的 Sheet2。
• 在工作表“RRR”中，您可能在“Y”列下方有一些不需要的数据，即如果您不小心将一些数据放入单元格中，当它上升时，它将停在该单元格并向下走一行并从那里写入'没有看到它。
• 这发生在不同的工作簿中。

这是怎么回事

Application.ScreenUpdating = True

什么时候

Application.ScreenUpdating = False

无处可寻。

这是您的第二个子的简化：

Private Sub CopyPaste(src As Worksheet, i As Long, trgt As Worksheet)
    src.Rows(i).Copy (trgt.Rows(trgt.Range("Y" & Rows.Count).End(xlUp).Row + 1))
End Sub

简化

您可能很快就会看到，代码开头的常量是救命稻草。

通常在不再需要对象变量时或至少在代码末尾释放对象变量。以下代码不使用任何使用Parent 属性实现的对象变量。

'*******************************************************************************
' Checks a column for a specified value, and each time it is found copies
' the entire current row to another worksheet below its last used row, using
' the CopyPaste_Simple Sub.
'*******************************************************************************
Sub ca_act_Simple()

    Application.ScreenUpdating = False

    Const strSource As Variant = "CAL"      ' Source Worksheet Name/Index
    Const strTarget As Variant = "RRR"      ' Target Worksheet Name/Index
    Const vntSourceCol As Variant = "Y"     ' Source Column Letter/Number
    Const lngSourceRow As Long = 1          ' Source First Row
    Const vntSearch as Variant = 1          ' Search Value

    Dim intRow As Long                      ' Row Counter

    With ThisWorkbook.Worksheets(strSource)
        For intRow = lngSourceRow To _
                .Cells(.Rows.Count, vntSourceCol).End(xlUp).Row
            If .Cells(intRow, vntSourceCol) = vntSearch Then
                ' calling the copy paste procedure
                CopyPaste_Simple .Parent.Worksheets(strSource), intRow, _
                    .Parent.Worksheets(strTarget)
            End If
        Next
    End With

    Application.ScreenUpdating = True

End Sub
'*******************************************************************************

'*******************************************************************************
' Copies the entire row to another worksheet below its last used row calculated
' from a specified column.
'*******************************************************************************
Sub CopyPaste_Simple(Source As Worksheet, SourceRowNumber As Long, _
        Target As Worksheet)

    ' It is assumed that the Target Worksheet has headers i.e. its first row
    ' will never be populated.

    Const vntTargetCol As Variant = "Y"     ' Target Column Letter/Number

    With Target
        Source.Rows(SourceRowNumber).Copy (.Rows(.Cells(.Rows.Count, _
            vntTargetCol).End(xlUp).Row + 1))
    End With

End Sub
'*******************************************************************************

改进

为了改进，我们将去掉第二个子：

'*******************************************************************************
' Checks a column for a specified value, and each time it is found copies
' the entire current row to another worksheet below its last used row
' calculated from a specified column.
'*******************************************************************************
Sub ca_act_Improve()

    Application.ScreenUpdating = False

    Const strSource As Variant = "CAL"      ' Source Worksheet Name/Index
    Const strTarget As Variant = "RRR"      ' Target Worksheet Name/Index
    Const vntSourceCol As Variant = "Y"     ' Source Column Letter/Number
    Const vntTargetCol As Variant = "Y"     ' Target Column Letter/Number
    Const lngSourceRow As Long = 1          ' Source First Row
    Const vntSearch as Variant = 1          ' Search Value         

    Dim intRow As Long                      ' Row Counter

    With ThisWorkbook.Worksheets(strSource)
        For intRow = lngSourceRow To _
                .Cells(.Rows.Count, vntSourceCol).End(xlUp).Row
            If .Cells(intRow, vntSourceCol) = vntSearch Then
                With .Parent.Worksheets(strTarget)
                    .Parent.Worksheets(strSource).Rows(intRow).Copy _
                    (.Rows(.Cells(.Rows.Count, vntTargetCol).End(xlUp).Row + 1))
                End With
            End If
        Next
    End With

    Application.ScreenUpdating = True

End Sub
'*******************************************************************************

在这个改进的版本中，最明显的是您在两个工作表中都使用了“Y”列，这可能是您遇到问题的原因。

第二个子

我认为最好添加第四个参数：

'*******************************************************************************
' Copies an entire row to another worksheet below its last used row.
'*******************************************************************************
Sub CopyPaste_Improve(Source As Worksheet, SourceRowNumber As Long, _
        Target As Worksheet, TargetColumnLetterNumber As Variant)

    ' It is assumed that the Target Worksheet has headers i.e. its first row
    ' will never be populated.

    With Target
        Source.Rows(SourceRowNumber).Copy (.Rows(.Cells(.Rows.Count, _
            TargetColumnLetterNumber).End(xlUp).Row + 1))
    End With

End Sub
'*******************************************************************************