Как зациклить строки с макросом Excel VBA? - PullRequest
Новая
       8

Как зациклить строки с макросом Excel VBA?

11 голосов
/ 10 февраля 2011

Я новичок в VBA, но довольно неплох с PHP. При этом я борюсь с петлями VBA ...

У меня есть этот лист с 40 строками, который называется "SH1": 

SH1

     A     B     C     D     E
 1   2   One    1.0a   12
 2   7   Two    2.0b   34
 3  13   Three  3.0c   56
 4  14   Four   4.0d   78
..
40

Мне нужно пройтись по 40 строкам и проверить значение в столбце A. Если значение в столбце A соответствует моим критериям (см. Ниже), сгенерируйте вывод и поместите его на другой лист.

Мой выходной лист состоит из 3 столбцов и называется «SH2»: 

SH2

     A     B     C     D     E
 1  1.0a   12    One
    2.0b   34    Two
 2  3.0c   56    Three
    4.0d   78    Four
..
15

Мои критерии для определения того, что и куда идет: 

// First loop:
if a1 < 8, put c1 in SH2 a1, put d1 in SH2 b1, put b1 in SH2 c1
if a2 < 8, put c2 in SH2 a1, put d2 in SH2 b1, put b2 in SH2 c1
// ... loop through a40 ...

Тогда: 

// Second loop:
if a1 > 8 AND a1 < 16, put c1 in SH2 a2, put d1 in SH2 b2, put b1 in SH2 c2
if a2 > 8 AND a2 < 16, put c2 in SH2 a2, put d2 in SH2 b2, put b2 in SH2 c2
// ... loop through a40 ...

РЕДАКТИРОВАНИЕ ПРОГРЕССА:

Кажется, работает, но интересно, есть ли "более чистый" способ? 

Sub CatchersPick2()
    Dim curCell As Range

    For Each curCell In Sheet4.Range("C3:C40").Cells
        If curCell.Value > 0 And curCell.Value < 73 Then
            cLeft = cLeft _
                & curCell.Offset(0, 5) & "." _
                & curCell.Offset(0, 6) & vbLf
            cMidl = cMidl _
                & curCell.Offset(0, -2) & ", " _
                & curCell.Offset(0, -1) & " " _
                & curCell.Offset(0, 7) & vbLf
            cRght = cRght _
                & curCell.Offset(0, 9) & " " _
                & curCell.Offset(0, 2) & " " _
                & curCell.Offset(0, 11) & " " _
                & curCell.Offset(0, 10) & vbLf
        End If
    Next curCell

    Sheet6.Range("B3") = cLeft
    Sheet6.Range("C3") = cMidl
    Sheet6.Range("D3") = cRght
    Sheet6.Range("B3:D3").Rows.AutoFit
    Sheet6.Range("B3:D3").Columns.AutoFit

End Sub

Ответы [ 3 ]

11 голосов
/ 10 февраля 2011 
Dim cell As Range
For Each cell In Range("a1:a40")
    'do stuff here
Next cell

Вы можете получить текущий ряд с помощью cell.Row. Удачи ^ _ ^

3 голосов
/ 10 февраля 2011

Как насчет: 

Sub Catchers()
    Dim cell As Range

    Sheet1.Select 'SHEET: C

    For Each cell In Range("C3:C40")
        If cell.Value < 35 And cell.Value > 0 Then
            With Sheet6
                .Range("B" & cell.Row) = cell.Offset(0, 5) _
                    & "." & cell.Offset(0, 6)

                .Range("C" & cell.Row) = cell.Offset(0, -2) _
                    & ", " & cell.Offset(0, -1) _
                    & " " & cell.Offset(0, 7)

                .Range("D" & cell.Row) = cell.Offset(0, 9) _
                    & " " & cell.Offset(0, 2) _
                    & " " & cell.Offset(0, 11) _
                    & " " & cell.Offset(0, 10)
            End With
        End If
    Next cell

    Sheet6.Range("B4:D4").Rows.AutoFit
    Sheet6.Range("B4:D4").Columns.AutoFit

End Sub
1 голос
/ 10 февраля 2011

Ты мало что можешь сделать, но ...

Во-первых, не используйте слово «ячейка» в качестве переменной, оно может работать, но играет с огнем, поэтому 

Dim curCell as Range

Во-вторых, вы должны пройти через свойство Cells в Range 

For Each curCell In Range("C3:C40").Cells

В-третьих, вам не нужно выбирать ячейку, вы можете просто манипулировать переменной curCell

Наконец, вам не нужно использовать ActiveCell, просто используйте переменную curCell. 

If curCell.Value < 35 And curCell.Value > 0 Then

    cLefta = curCell.Offset(0, 5) & "."

Фактически, вы также можете просто использовать короткую переменную типа 'c' и поместить все это в одну строку: 

cLeft = c.Offset(0,5) & "." & c.Offset(0,6) & vblf

Примечание. Если ваша настройка всегда близка к одной и той же, возможно, будет проще использовать функции листа.

...