Изменение значений блоков ячеек в столбце, разделенных пустыми ячейками

Question

У меня есть столбец данных с блоками непустых ячеек, за которыми следуют блоки пустых ячеек. См. Рисунок ниже. Я пытаюсь разработать макрос, который вставляет формулы в каждый блок непустых ячеек и заканчивается, когда он достигает последнего непустого блока ячейки в столбце. Я не могу понять, как обобщить поиск первой и последней ячейки в каждом непустом блоке ячейки. Возможно, существует некоторый метод подсчета, такой как firstrow(i) и lastrow(i) Любые предложения приветствуются. Благодаря!

расположение данных:

Macro:

Sub test() 

Dim r As Integer 
Dim firstrowX, lastrowX As Long 
Dim sht As Worksheet 
Set sht = Sheets("Sheet1") 

With sht 

'first row in block 
firstrowX = sht.Cells(3, 12).End(xlDown).Row 
'last row in block 
lastrowX = sht.Cells(firstrowX, 12).End(xlDown).Row 
'last row in column 
lastrowCol = sht.Cells(Rows.count, 12).End(xlUp).Row 

    For r = firstrowX To lastrowX 

     If r <> lastrowX Then 
     .Cells(r, 12).FormulaR1C1 = "=IF(RC[-1]=RC[-6],1, IF(R" & lastrowX & "C[]=1, -1, 0))" 
     Else 
     .Cells(r, 12).FormulaR1C1 = "=IF(RC[-1]=RC[-6],1,0)" 
     End If 
     If lastrowX = lastrowCol Then 
     Exit Sub 

    Next r 

End With 

End Sub 

Answer 1

Видя, как вы цикл через все ячейки в этом столбце в любом случае, вы могли бы просто использовать блок, если:

For r = firstrowX To lastrowX 
If Cells(r, 12).Value <> vbNullString Then 
     If r <> lastrowX Then 
     .Cells(r, 12).FormulaR1C1 = "=IF(RC[-1]=RC[-6],1, IF(R" & lastrowX & "C[]=1, -1, 0))" 
     Else 
     .Cells(r, 12).FormulaR1C1 = "=IF(RC[-1]=RC[-6],1,0)" 
     End If 
     If lastrowX = lastrowCol Then 
     Exit Sub 
End If 

Next r 

---

Но проще метод будет использовать SpecialCells()

Предполагая, что ваши клетки содержат постоянные данные, как ваше изображение предлагает:

For Each cell In .Range("L2:L" & .Cells(.Rows.Count, 12).End(xlUp).Row).SpecialCells(xlCellTypeConstants) 
    If cell.Offset(1, 0).Value = vbNullString Then 
     cell.FormulaR1C1 = "=IF(RC[-1]=RC[-6],1,0)" 
    Else 
     cell.FormulaR1C1 = "=IF(RC[-1]=RC[-6],1, IF(R" & cell.End(xlDown).Row & "C[]=1, -1, 0))" 
    End If 
Next 

Answer 2

Используйте Range.SpecialCells method. Если клетки уже содержат формулы возвращающихся число, вы можете настроить таргетинг, что подмножество специально с xlCellType Enumeration

Dim lastrowX As Long 
With Sheets("Sheet1").Columns(12) 
    lastrowX = .Cells(Rows.Count, 1).End(xlUp).Row 
    With .Cells.SpecialCells(xlCellTypeFormulas, xlNumbers) 
     .FormulaR1C1 = "=IF(RC[-1]=RC[-6],1, IF(R" & lastrowX & "C[]=1, -1, 0))" 
    End With 
    .Cells(lastrowX, 1).FormulaR1C1 = "=IF(RC[-1]=RC[-6],1,0)" 
End With 

Answer 3

Это один не столь компактен, как и другие, но это написано похоже на ваш. Вы можете пройти через это, чтобы увидеть, как работает эта формула:

Sub example() 

Application.ScreenUpdating = False 

With ActiveSheet 
    lastRow = .Cells(.Rows.Count, 12).End(xlUp).row 
    'lastRow = .UsedRange.Rows.Count 
End With 

Dim Column2Copy As String 
Column2Copy = "L" 

Dim startCell As Range 
Set startCell = Cells(3, 12).End(xlDown) 


Do While startCell.row < lastRow 
    If startCell.End(xlDown).Offset(-1, 0).row > lastRow Then 
     newLastRow = lastRow 
    Else 
     newLastRow = startCell.End(xlDown).Offset(-1, 0).row 
    End If 

    If newLastRow > lastRow Then 
     Range(Cells(startCell.row, Column2Copy), Cells(newLastRow, Column2Copy)).FormulaR1C1 = "=IF(RC[-1]=RC[-6],1, IF(R" & lastRow & "C[]=1, -1, 0))" 
    Else 
     Range(Cells(startCell.row, Column2Copy), Cells(newLastRow, Column2Copy)).FormulaR1C1 = "=IF(RC[-1]=RC[-6],1,0)" 
    End If 

    Set startCell = startCell.End(xlDown) 

Loop 

Application.ScreenUpdating = True 

End Sub