vba - 使用VBA查找起始值，计算行数直到该值变为0并记录结果。对同一列重复此操作，直到到达数据末尾

Question

总的来说，我是 VBA/编码的新手，我通常使用的粘贴预先编写的代码的策略无法解决我的问题。

我正在创建一个可以完成三件事的宏:

1. 请允许我找到列中数据的起点。
2. 一旦单元格值达到，就开始计算行数更改为常数。
3. 一旦值移回起始点，计数就会停止，并记录在单独列中计数的单元格数量，并将该列中的计数定位在计数起始点。
4. 重复直到数据结束。

对于这种情况，起始点将是单元格的值 >0 时。它将增加到一个常数 (300)。一旦达到 300，宏就必须计算包含数值 300 的行数，直到该值返回到 0。在工作表上的单独表中报告计数，并在新表中与从数据开始计数时相同的相对位置输入条目。最后是循环。

我还需要在水平方向上进行类似的计数(即计算一行上的列数)。如果任何人都可以为上面的垂直/行计数问题创建代码，如果您可以对其进行注释，我将非常感激，以便我可以尝试理解/学习哪些代码执行每个操作，从而将其更改为水平/列计数。

我已附上电子表格的屏幕截图，但作为新用户，它必须作为链接。蓝色突出显示的表格是用于我正在讨论的垂直/行计数问题的数据。突出显示的表格下方的空白表格已手动输入第一列数据的正确答案，以说明我希望宏执行的操作，以防我没有准确描述我的请求。

我还附上了水平表，其中包含单独表中第 1 行的正确手动输入答案，以了解该行的列数。

最后，这是我为解决该问题而编写的代码，但它非常基本，无法运行。

Sub  Count0()
  For Each c In Worksheets("Sheet1").Range("D30:D39")
     If c.Value = 0 Then
     End If
     If c.Value > 0 Then
       v = Range(c.Value)
       For i = 3 To Rows.Count
         If Cells(i, 1).Value <> v Then
           MsgBox CStr(i - 2)
         End If         
       Next i

  Next c
End Sub

Answer 1

这在我测试的有限情况下有效(不同模式的两列和几行。这是非常基本的 - 有更优雅的方法来做到这一点。

Sub Count0()

'To hold the current cell
Dim current As Range

'To hold the total number of rows and columns having data
Dim rows As Long
Dim cols As Long

'To iterate across rows and columns
Dim r As Long
Dim c As Long

'Flag/counter variables
Dim found As Long       'Saves row on which first "constant" was found
Dim count As Long       'Saves count of "contants"

'Use SpecialCells method to obtain the maximum number of rows and columns
' that have data.
cols = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Column
rows = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row

'Increment through all columns that have data. This is a bit inefficient
' because it really isn't necessary to go through all the empty cells,
' but it works.
For c = 1 To cols

    'Initialize flag/counter
    found = 0
    count = 0

    'Increment through all rows for the current column.
    For r = 1 To rows

        'Examine the current cell
        Set current = Worksheets("Sheet1").Cells(r, c)

        'For positive values, save the first row that has the value
        ' and count the number of values.
        If current.Value > 0 Then
            If found = 0 Then found = r
            count = count + 1
        End If

        'When the next non-positive value is reached--OR the end of the
        ' row is reached--and there was a constant found, write the count
        ' to the next worksheet in the cell corresponding to the row and
        ' column having the first instance of the constant.
        If (current.Value <= 0 Or r = rows) And found > 0 Then

            Worksheets("Sheet2").Cells(found, c).Value = count

            'Reset the flag/counter
            found = 0
            count = 0

        End If
    Next r
Next c

End Sub