更改列中由空单元格分隔的单元格块的值

Question

我有一列数据，其中包含非空单元格块，后跟空单元格块。见下图。我正在尝试开发一个宏，在每个非空单元格块中插入公式，并在到达列中最后一个非空单元格块时结束。我无法弄清楚的是如何概括在每个非空单元格块中找到第一个和最后一个单元格。也许有一些计数方法，例如 firstrow(i) 和 lastrow(i) 非常感谢任何建议。谢谢！

数据布局：

宏：

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

既然您要遍历该列中的所有单元格，您可以只使用 If 块：

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. If the cells already contain formulas returning numbers, you can target that subset specifically with the 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

更改列中由空单元格分隔的单元格块的值

Change values of blocks of cells in column separated by empty cells

excel

vba

row