Excel 宏：工作簿之间的条件剪切和粘贴

Question

所以我想要一个在 Excel 文件（“input.xls”）中运行的宏，它正在另一个 Excel 文件（“data.xls”）中搜索值“1”的列（该列中的唯一值是1 和 0）。当它找到“1”时，它应该将该文件中的整行复制并粘贴到“input.xls”中。

这是我的代码

Sub NonErrorDataParse()
    Dim intEnd As Integer

    Workbooks("data.xls").Sheets("Raw").Activate

    intEnd = 65000

    Range("F").Select

    Do Until ActiveCell.Row = intEnd

        If Int(ActiveCell.Value) = 1 Then
            Range(ActiveCell.Row & ":" & ActiveCell.Row).Cut
            intEnd = intEnd - 1
            Workbooks("input.xls").Sheets("Non-errors").Activate
            Range("A1").Select
            ActiveSheet.Paste
        Else
            ActiveCell.Offset(1, 0).Select
        End If

    Loop

End Sub

但是，当我运行它时，它会在“data.xls”上显示“下标超出范围”错误。无论我如何摆弄代码，我似乎都无法克服该错误（即使我有其他宏正在访问工作正常的工作表）。

关于如何解决它的任何想法？或者更好的代码可以做同样的事情？

提前致谢

Answer 1

您不必每次执行命令时都Select 或Activate。
您还可以使用 Range("A65536").End(xlup) 查找最后使用的单元格，而不是解析每个单元格（这可能导致您的错误）。

代码如下所示：

Sub NonErrorDataParse()
    Dim intEnd As Integer
    Dim c As Range

    intEnd = Workbooks("data.xls").Sheets("Raw").Range("A65536").End(xlUp).Row

    For Each c In Workbooks("data.xls").Sheets("Raw").Range("F1:F" & intEnd)
       If CStr(c.Value) = "1" Then
           c.EntireRow.Cut
           Workbooks("input.xls").Sheets("Non-errors").Rows("1:1").Insert Shift:=xlDown
       End If
    Next c
End Sub

然而，如果您有很多行，使用autofilter 方法或使用字典会更快。