일치하는 셀 값을 확인하십시오.

Question

계속 증가하는 목록이 있습니다.

특정 셀 값이 10보다 큰 경우 전체 행을 특정 워크 시트에 복사해야합니다. 값이 10 이하이면 데이터가 들어있는 마지막 행에 도달 할 때까지 다음 행을 검사해야합니다.

이것은 현재 매크로입니다. 이전과 같은 행에 행을 복사합니다. 나는 그들이 자유 공간없이 목록에 올 필요가있다.

Sub Copy() 
Dim s1 As Worksheet, s2 As Worksheet 
Dim N As Long, i As Long, j As Long 
Set s1 = Sheets("Hours") 
Set s2 = Sheets("Check") 
N = s1.Cells(Rows.Count, "R").End(xlUp).Row 
j = 1 
For i = 1 To N 
    If s1.Cells(i, "R").Value > "10" Then 
     s1.Cells(i, "R").EntireRow.Copy s2.Cells(j, 1) 
     j = j + 1 
    End If 
Next i 
End Sub 

Answer 1

을

나는 원래 코드에서 (심지어이었다 매우 유혹 AutoFilter 방법을 사용하지만) 멀리 이동하지 않으려 고 노력

나는 당신의 오류가 완전히 당신이 N (마지막 행)을 찾고 길을 충족하지 때문이라고 생각; N = s1.Cells(Rows.Count, "R").End(xlUp).Row을 사용하고 ActiveSheet이 다른 시트 인 경우 Rows.Count에 대해 다른 값을 얻습니다. 방금 워크 시트 참조를 추가했습니다 N = s1.Cells(s1.Rows.Count, "R").End(xlUp).Row

"R"열에 텍스트가있는 경우 If 기준을 'IsNumeric (s " & I)) 그리고 s1.Range ("R"& I) .Value> 10 Then`

코드

Sub Copy() 

Dim s1 As Worksheet, s2 As Worksheet 
Dim N As Long, i As Long, j As Long 

Set s1 = Sheets("Hours") 
Set s2 = Sheets("Check") 

N = s1.Cells(s1.Rows.Count, "R").End(xlUp).Row 
j = 1 
For i = 1 To N 
    If IsNumeric(s1.Range("R" & i)) And s1.Range("R" & i).Value > 10 Then 
     s1.Cells(i, "R").EntireRow.Copy s2.Cells(j, 1) 
     j = j + 1 
    End If 
Next i 

End Sub 

Answer 2

빈 행 (빈 확인하기 위해 열/행의 최대 범위의 범위 "C50"로 변경) 삭제, 현재 스크립트를 완료 할 때 당신은 후 공정을 수행 할 수 있습니다

dim r As Range, rows As Long, i As Long 
    Set r = Sheets("Check").Range("A1:C5000") 
    rows = r.rows.Count 
    For i = rows To 1 Step (-1) 
    If WorksheetFunction.CountA(r.rows(i)) = 0 Then r.rows(i).Delete 
    Next