搜索範圍值的變化，如果發現複製整行

Question

我很新的VBA（約4天新），並試圖解決這個問題，在我平時的方法，通過閱讀很多不同的職位上這樣的資源和試驗，但一直未能完全掌握它。我希望你們這些好人願意指出我會在哪裏出錯。我已經看了很多（所有？）的線程，但都沒有能夠爲他們拼湊出一個解決方案。如果它已經在其他地方得到了回覆，我希望你能原諒。

上下文：

我行有一個電子表格的項目5-713向下柱B（合併到小區j），其中每個日期（列K-SP）的項目被刻痕或爲1或0. 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是1 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