값 변경을위한 검색 범위, 찾을 경우 전체 행

Question

저는 VBA (~ 4 일 신규)에 매우 익숙하며 일반적인 방법으로이 문제를 해결하기 위해 이와 같은 리소스에 대한 많은 게시물을 읽고 실험하고는 있지만, 그걸 알아 채지 못했습니다. 좋은 사람들이 제가 잘못하고있는 부분을 지적 해 주길 바랍니다. 비슷한 문제가있는 스레드를 많이 (모두?) 살펴 보았지만 나 자신을위한 해결책을 함께 모을 수는 없었습니다. 이미 다른 곳에서 대답 한 적이 있다면 용서할 수 있기를 바랍니다.

상황 :

내가 행 항목 (세포 J까지 합병) 5-713 아래로 열 B를 스프레드 시트를 가지고 각 날짜에 대한 (열은 K-SP) 항목이 하나 하나 채점 또는 0입니다. 나의 목표는 워크 시트 맨 아래에 1에서 0까지 모든 항목을 포함하는 목록을 만드는 것입니다. 시작하려면 모든 행을 복사하기 위해 "목록 생성"단추를 가져 오려고했습니다 그 밑에 0을 넣고 나중에 내가 원하는대로 정확하게 조정할 것이라고 생각했습니다. 여러 가지 시도를했는데 몇 가지 다른 오류가 발생했습니다.

Worksheet Sample 내가 말하는 것에 대한 시각적 정보.

나는 여러 가지 시도를 해봤으며 각각 성공에 한계가 있었으며 매번 다른 오류가 발생했습니다. 나는 "method"범위의 '_Worksheet failed ","object required ","type mismatch ","out of memory "및 기타 몇 가지를 가졌습니다. 나는 약간의 문제를 야기하는 몇 가지 기본적인 문법을 이해하지 못하고있을 것이라고 확신한다.

다음은 '유형 불일치'오류를 표시하는 최신 코드 배치입니다. 나는 또한 가지고 '할 일'이 될 문자열을 시도했지만 그건 그냥 내가 약속 있다고 생각하는 또 다른 시도가 다음이었다

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을 구별하는 방법과 항목 ​​이름에서 0을 구별하는 방법을 잘 모르겠습니다 (예를 들어 '항목 10'을 목록에 넣는 것은 좋지 않습니다. 0 이후).

이 첫 번째 단계를 알아내는 데 도움이되거나 0으로 바뀌는 1을 스캔하는 방법에 대한 도움이 있으면 감사하겠습니다. 나는 단순한 무언가를 놓치고 있고, 너희들이 내 무지를 용서할 수 있기를 바란다.

감사합니다.

Answer 1

데이터를 조사하여 데이터의 마지막 행 아래로 복사합니다. 그것은 데이터 아래에 아무것도 없다고 가정합니다. 또한 만이 연결된 워크 시트 샘플에서 "1 0까지 갔다"무엇 항목의 예를주는 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