计算行数，包括空白行，直到遇到2个空白

Question

当前有一个宏，该宏计算用作变量的行数。由于具有空白行的新数据源不再起作用。

我需要它继续计数，直到它到达两个空白为止，这是数据源的末尾，但还要在计数中包括空白行。

我有一个宏，该宏对行数进行计数，以为单独的宏提供变量，该单独的宏将该数字用于循环功能。一切工作正常，除了要计数的新数据之间的空白行（必须保留并包括在总行数中）。

我可以弄清楚如何分别计算非空白和完整单元格，但不能弄清楚如何一起计算。有什么建议吗？

Sub num_rows(nrows As Variant)
    Dim numrows
    Dim ra As Range
    Dim i As Integer

    'get number of rows between blank cells
    Sheets("4 Gantt Overview").Activate
    Set ra = Range("b7")

    numrows = Range(ra.Address,Range(ra.Address).End(xlDown)).rows.Count
    Range(ra.Address).Select

    'establish counting loop
    For i = 1 To numrows      
        ActiveCell.Offset(1, 0).Select          
    Next

    nrows = numrows        
    Range("b7").Select 
End Sub

对于130行和2个空白的数据集，其计数仅计30行（第一个空白位置）。

Answer 1

想象以下数据：

如果要查找前2个空白，可以使用.SpecialCells(xlCellTypeBlanks)来资助您范围内的所有空白（此处为A列）。它将变成类似于图像中选定单元格的东西。您可以使用.SpecialCells(xlCellTypeBlanks).Areas访问6个选定区域。

因此，如果我们遍历所有这些区域For Each Area In .Areas并检查它们的行数If Area.Rows.Count >= 2，我们可以轻松地找到包含2行（或至少2行）的区域。

行数（是否为空）为Area.Row - AnalyzeRange.Row

所以我们最终得到：

Option Explicit

Sub TestCount()
    MsgBox CountRowsUntilTwoBlanks(Worksheets("Sheet1").Range("A:A"))
End Sub


Function CountRowsUntilTwoBlanks(AnalyzeRange As Range) As Long
    Dim Area As Range
    For Each Area In AnalyzeRange.SpecialCells(xlCellTypeBlanks).Areas
        If Area.Rows.Count >= 2 Then 'if 2 or more then use >=2, if exactly 2 use =2
            CountRowsUntilTwoBlanks = Area.Row - AnalyzeRange.Row
            Exit For
        End If
    Next Area
End Function

因此，在此示例中，它将返回16行。

---

请注意，如果您的目标是找到最后使用的行（在本示例中为第20行），则可以使用…

Dim LastRow As Long
With Worksheets("Sheet1")
    LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

…查找A列中最后使用的行。这里LastRow返回20。

Answer 2

此宏。它将找到空白的第一个单元格，以及随后的空白单元格。

Sub stopAtDoubleBlank()

        Dim i As Long

        i = 2
        Do While Range("A" & i).Value <> "" Or Range("A" & i + 1) <> ""

            i = i + 1
        Loop

        MsgBox i

End Sub

Answer 3

如果需要，您也可以尝试这样的事情：

Sub lastrow()
    Dim lr As Long
    lr = ActiveSheet.Rows.Count
    Cells(1, lr).Select
    Selection.End(xlUp).Select
    lr = ActiveCell.Row
End Sub

（下降到最底部，跳至Cloumn中的最后一个非空行（可以更改），如果想在末尾空行，也可以添加+1之类的东西）