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

Question

我对VBA很新（大约4天新），并尝试用我常用的方法解决这个问题，通过阅读许多不同的帖子对这样的资源进行实验，但是还是没能完成掌握它。我希望你好，人们愿意指出我在哪里出错了。我已经看了很多（所有？）类似问题的线程，但是我们还没有能够从他们那里为自己拼凑一个解决方案。如果已经在其他地方得到解答，我希望你能原谅这一点。

上下文：

我有一个电子表格，其中第5-713行的项目位于B栏下方（合并到单元格J），对于每个日期（列K-SP），该项目的评分为1或0。目标是在工作表的底部创建一个列表，其中包含从1到0的所有项目。首先，我只是试图获取我的生成列表＆＃34;按钮将所有行中带有0的行复制到底部，这意味着我稍后会调整它以完全按照我想要的方式进行调整。我尝试了几件事并得到了几个不同的错误。

Worksheet Sample了解我正在谈论的内容。

我经历了几次不同的尝试，并且每次都取得了有限的成功，通常每次都会遇到不同的错误。我有＆＃34;方法＆＃39;对象范围＆＃39; _Worksheet失败＆＃34;，＆＃34;对象需要＆＃34;，＆＃34;类型不匹配＆＃34;，＆＃34;内存不足＆＃34;以及其他一些。我确定我根本没有掌握一些基本语法，这会导致一些问题。

这是最新一批代码，给出了错误＆＃39; type mismatch＆＃39;。我也曾尝试过＃todo＆＃39;是字符串，但只是射击＆＃39;需要的对象＆＃39;

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

我认为另一种有希望的尝试是以下内容，但它让我失去了内存＆＃39;。

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＆＃39;进入列表中不是很好因为10是1，后面有0）。

任何有助于弄清楚这第一步的帮助，或者甚至是如何让它扫描转向0的1将会非常感激。我确定我错过了一些简单的东西，并希望你们能原谅我的无知。

谢谢！

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