搜索值更改的范围，如果找到则复制整行

Question

我对 VBA 非常陌生（大约 4 天新），并尝试以我通常的方法解决这个问题，通过阅读大量关于此类资源的不同帖子并进行实验，但未能完全了解挂起来。我希望你们好人愿意指出我在哪里出错了。我已经查看了很多（全部？）具有类似问题的线程，但无法从它们中为自己拼凑出一个解决方案。如果它已经在其他地方得到回答，我希望你能原谅它。

上下文：

我有一个电子表格，其中包含 B 列下 5-713 行中的项目（合并到单元格 J），其中每个日期（K-SP 列）项目的得分为 1 或 0。我的目标是在工作表底部创建一个列表，其中包含所有从 1 变为 0 的项目。首先，我只是试图让我的“生成列表”按钮将所有包含 0 的行复制到底部，我想我以后会调整它来做我想要的。我尝试了几件事并得到了几个不同的错误。

Worksheet Sample 了解我在说什么。

我经历了几次不同的尝试，但每次都取得了有限的成功，通常每次都会遇到不同的错误。我遇到了“方法'对象范围'_Worksheet失败”、“需要对象”、“类型不匹配”、“内存不足”等等。我确定我只是没有掌握一些基本语法，这导致了一些问题。

这是最新一批代码，给我错误“类型不匹配”。我也尝试过让“待办事项”成为字符串，但这只会发出“需要对象”

Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim y As Integer, z As Integer, todo As Range

Set todo = ThisWorkbook.ActiveSheet.Range(Cells(5, 2), Cells(713, 510))

y = 5
z = 714
With todo
    Do
        If todo.Rows(y).Value = 0 Then
        todo.Copy Range(Cells(z, 2))
        y = y + 1
        z = z + 1
        End If
    Loop Until y = 708
End With


Application.ScreenUpdating = True
End Sub

我认为有希望的另一个尝试是以下，但它让我“失忆”。

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim y As Integer, z As Integer

y = 5
z = 714

Do
    If Range("By:SPy").Value = 0 Then
    Range("By:SPy").Copy Range("Bz")
    y = y + 1
    z = z + 1
    End If
Loop Until y = 708

Application.ScreenUpdating = True
End Sub

重申一下，我发布的代码尝试只是将任何包含 0 的行放到电子表格的底部，但是，如果有一种方法可以定义搜索 1 的标准，然后变成 0，那就是惊人！此外，我不确定如何区分实际数据中的 0 和项目名称中的零（例如，将“项目 10”放入列表中并不是很好，因为 10 是一个带有0 之后）。

任何帮助弄清楚这第一步，或者甚至如何让它扫描 1 变成 0 的，将不胜感激。我确定我遗漏了一些简单的东西，希望你们能原谅我的无知。

谢谢！

Answer 1

这会查看数据并将其复制到数据最后一行的下方。假设数据下方没有任何内容。它也只在 找到 1 之后查找零。

Sub findValueChange()

    Dim lastRow As Long, copyRow As Long, lastCol As Long
    Dim myCell As Range, myRange As Range, dataCell As Range, data As Range
    Dim hasOne As Boolean, switchToZero As Boolean
    Dim dataSht As Worksheet




    Set dataSht = Sheets("Sheet1") '<---- change for whatever your sheet name is

    'Get the last row and column of the sheet
    lastRow = dataSht.Cells(Rows.Count, 2).End(xlUp).row
    lastCol = dataSht.Cells(5, Columns.Count).End(xlToLeft).Column

    'Where we are copying the rows to (2 after last row initially)
    copyRow = lastRow + 2

    'Set the range of the items to loop through
    With dataSht
        Set myRange = .Range(.Cells(5, 2), .Cells(lastRow, 2))
    End With

    'start looping through the items
    For Each myCell In myRange
        hasOne = False 'This and the one following are just flags for logic
        switchToZero = False
        With dataSht
            'Get the range of the data (1's and/or 0's in the row we are looking at
            Set data = .Range(.Cells(myCell.row, 11), .Cells(myCell.row, lastCol))
        End With
        'loop through (from left to right) the binary data
        For Each dataCell In data
            'See if we have encountered a one yet
            If Not hasOne Then 'if not:
                If dataCell.Value = "1" Then
                    hasOne = True 'Yay! we found a 1!
                End If
            Else 'We already have a one, see if the new cell is 0
                If dataCell.Value = "0" Then 'if 0:
                    switchToZero = True 'Now we have a zero
                    Exit For 'No need to continue looking, we know we already changed
                End If
            End If
        Next dataCell 'move over to the next peice of data

        If switchToZero Then 'If we did find a switch to zero:
            'Copy and paste whole row down
            myCell.EntireRow.Copy
            dataSht.Cells(copyRow, 2).EntireRow.PasteSpecial xlPasteAll
            Application.CutCopyMode = False
            copyRow = copyRow + 1 'increment copy row to not overwrite
        End If

    Next myCell


    'housekeeping
    Set dataSht = Nothing
    Set myRange = Nothing
    Set myCell = Nothing
    Set data = Nothing
    Set dataCell = Nothing


End Sub