поиск числа в таблице

[Ilya_L]

здравствуйте.
помогите с такой задачей. имеется у меня код такой

Sub perenos_2()
Dim x As Range, y As Range, z As Range, fst As String: Application.ScreenUpdating = False
    
    Sheets(1).Activate: Sheets(2).Cells.ClearContents
    Set z = Range([D4], Cells(Rows.Count, 1).End(xlUp).Offset(, 5))
    Set x = z.Find(what:=2, LookAt:=xlWhole)
    
    If Not x Is Nothing Then
        fst = x.Address
        Do
            If y Is Nothing Then Set y = x Else Set y = Union(y, x)
            Set x = z.FindNext(x)
        Loop While fst <> x.Address
    End If
    
    If Not y Is Nothing Then
        y.EntireRow.Copy Sheets(2).Rows(2): y.EntireRow.Delete
    End If

End Sub

и надо, чтобы он находил в диапазоне (E:F) число 2, а в столбце D промежуток >=1 и <=30 [1;30] и переносил на второй лист... Только нужно код где-то поправить, я не знаю где!
Илья!

[Ilya_L]

что нужно изменить в коде, чтобы в столбце D находил числа [1;30], а в столбцах E и F только 2?

[SAS888]

Если требуется переносить строки при совпадении обоих условий, то можно, например, так:

Sub perenos_2()
    Dim x As Range, y As Range, z As Range, fst As String: Application.ScreenUpdating = False
    Sheets(1).Activate: Sheets(2).Cells.ClearContents
    Set z = Range([D4], Cells(Rows.Count, 1).End(xlUp).Offset(, 5))
    Set x = z.Find(what:=2, LookAt:=xlWhole)
    If Not x Is Nothing Then
        fst = x.Address
        Do
            If Cells(x.Row, "D") >= 1 And Cells(x.Row, "D") <= 30 Then
                If y Is Nothing Then Set y = x Else Set y = Union(y, x)
            End If
            Set x = z.FindNext(x)
        Loop While fst <> x.Address
    End If
    If Not y Is Nothing Then
        y.EntireRow.Copy Sheets(2).Rows(2): y.EntireRow.Delete
    End If
End Sub

[Ilya_L]

Спасибо SAS888, вы мне очень помогли!

[Ilya_L]

Программа не работает...пробовал перенести, а он не переносит ни число 2 из E и F, ни [1;30] в столбце D, все оставляем в таблице на первом листе

[SAS888]

Программа не работает...

Зачем так категорично и не правильно???
Программа работает. Если не так, как Вам нужно - значит Вы так объяснили. Посмотрите вложение. Откройте файл и выполните макрос. Все строки 1-го листа, которые содержат в столбце "D" значения от 1 до 30, и в столбце "E" или "F" значение 2, будут перенесены на 2-й лист. Макрос во вложении без изменений.

[Ilya_L]

Понятно, как она работает...Значит я не так сформулировал...
попробую по другому объяснить... столбы с D по F называются ЕГЭ, Экзамен и Аттестат(балл). двойка при ЕГЭ равна такому промежутку [1;30], а в полях Экзамен и аттестат все нормально.. Поэтому, если хотя бы в одной из ячеек строки стоит число 2 (для ЕГЭ промежуток от 1 до 30), то перенести на другой лист..не для обоих случаев, когда D и E или D и F равны 2.

[SAS888]

Это совершенно другая задача. Можно так:

Sub Main()
    Dim i As Long: Application.ScreenUpdating = False
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If (Cells(i, 4) >= 1 And Cells(i, 4) <= 30) Or Cells(i, 5) = 2 Or Cells(i, 6) = 2 Then
            Rows(i).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1): Rows(i).Delete
    End If: Next
End Sub

[Ilya_L]

Сообщение от SAS888

Это совершенно другая задача. Можно так:

Sub Main()
    Dim i As Long: Application.ScreenUpdating = False
    For i = Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
        If (Cells(i, 4) >= 1 And Cells(i, 4) <= 30) Or Cells(i, 5) = 2 Or Cells(i, 6) = 2 Then
            Rows(i).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1): Rows(i).Delete
    End If: Next
End Sub

понятно, и ничего даже сложного нет...а я пытался в ту программу вставить условие.. а что означает For i ... To 2 Step -1?

[SAS888]

а что означает For i ... To 2 Step -1?

Т.к. мы в цикле по строкам удаляем строки, то для того, чтобы не нарушился счетчик цикла, строки нужно перебирать снизу вверх.
Т.е. от последней заполненной строки до 2-й с шагом минус 1.