excel – 使用VBA查找起始值,计算行直到该值变为0并记录结果.重复相同的列,直到达到数据的末尾

我一般都是VBA /编码的新手,而我常用的一些预先编写代码的策略并不能解决我的问题.

我正在寻找一个可以做三件事的宏:

>允许我在列中找到数据的起点.
>单元格值开始计算行数
改为常数.
>一旦值移回计数停止的起始点,并记录单独列中计数的单元格数,并在计数的起始点定位该列中的计数.
>重复直到数据结束.

对于这种情况,起始点将是当单元具有> 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

最佳答案 这适用于我测试的有限情况(两列和几行不同的模式.这是非常基本的 – 有更优雅的方法来做到这一点.

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
点赞