Как объединить строки с макросом Excel VBA?

Question

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

У меня есть этот лист с 40 строк, называемых «Ш1»:

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 ... 

ПРОГРЕСС EDIT:

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

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 

Answer 1

Dim cell As Range 
For Each cell In Range("a1:a40") 
    'do stuff here 
Next cell 

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

Answer 2

Там не много вы можете сделать, но ...

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

Dim curCell as Range 

Во-вторых, вы должны перебрать свойства Cells хребта

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) & "." 

В самом деле, вы также можете просто использовать короткую переменную типа «с» и положить все это на одной линии:

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

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

Answer 3

Как насчет:

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