Если и сделать до цикла EXCEL VBA

Новичок в VBA, если кто-то может помочь мне, что я делаю неправильно здесь. Попытка запустить цикл таким образом, чтобы он искал определенный текст, запускает цикл, а затем останавливается в определенной точке. Петли таковы, что я хочу, чтобы он скопировал некоторые значения ниже в моем листе, следовательно, a равно 55. Им грозит заблокировать сообщение об ошибке, если без конца, если

Вот код: 

Private Sub CommandButton3_Click()
For y = 1 To 15 Step 5
Dim x As Double
Dim a As Double
x = 1
a = 55
If Cells(x, y).Value = "Text1" Then
Do Until Cells(x, y).Value = "Text2"
Cells(a, y) = Cells(x, y).Value
Cells(a, y + 1) = Cells(x, y + 1)
x = x + 1
a = a + 1


Loop


End Sub
2 5
excel vba excel-vba if-statement

2 ответа:

Помимо вопросов, которые я упомянул в комментариях к вашему сообщению, если я правильно вас понял, вы хотите сделать цикл по ячейкам в столбце А, найти первый "Text1", а затем скопировать все ячейки в строку 55 и ниже, пока не найдете"Text2". Если это так, попробуйте следующий код: 

Private Sub CommandButton3_Click()

Dim x As Long, y As Long
Dim a As Long
Dim LastRow As Long

With Worksheets("Sheet1") '<-- modify "Sheet1" to your sheet's name
    For y = 1 To 15 Step 5

        x = 1  '<-- reset x and a (rows) inside the columns loop
        a = 55 '<-- start pasting from row 55

        LastRow = .Cells(.Rows.Count, y).End(xlUp).Row
        While x <= LastRow '<-- loop until last row with data in Column y
            If .Cells(x, y).Value Like "Text1" Then
                Do Until .Cells(x, y).Value = "Text2"
                    .Cells(a, y).Value = .Cells(x, y).Value
                    .Cells(a, y + 1).Value = .Cells(x, y + 1).Value
                    x = x + 1
                    a = a + 1
                Loop
            End If
            x = x + 1
        Wend
    Next y
End With

End Sub
2

Отступ-это путь вперед, у вас есть for оператор без next и if Без End If: 

Private Sub CommandButton3_Click()
    For y = 1 To 15 Step 5
        Dim x As Double
        Dim a As Double
        x = 1
        a = 55
        If Cells(x, y).Value = "Text1" Then
            Do Until Cells(x, y).Value = "Text2"
                Cells(a, y) = Cells(x, y).Value
                Cells(a, y + 1) = Cells(x, y + 1)
                x = x + 1
                a = a + 1
            Loop
        End If
    Next y
end sub
4