Using VBA to find the starting value, count the lines until that value becomes 0 and results in a write result. Repeat for the same column until the end of the data reached.

Question

I am new to VBA / coding in general, and my usual tactic of gluing bits of pre-written code does not work for my problem.

I want to create a macro that will do 3 things:

• Let me find the starting point for the data in a column.
• Start counting the number of rows after the cell value is changed to a constant.
• As soon as the value returns to the starting point for stopping the count and writes down the number of cells counted in a separate column, with the position of the count in this column at the starting point of counting.
• Repeat until the end of the data.

In this case, the starting point will be when the cell has a value> 0. It will increase to a constant number (300). Sometime in 300, a macro will have to count the number of rows containing a numerical value of 300, until the value returns to 0. The number of reports in a separate table on a sheet with the record entered in the same relative position in the new table as with starting an account from the data. And finally, the cycle.

I also need to do a similar count, but in the horizontal direction (i.e. counting the columns in a row). If someone can create the code for the problem with the vertical / numerical line above, I would really appreciate it if you could annotate it so that I can try to understand / find out which bits of the code do each action and thereby change it for horizontal / column count

, , . - , / , . , , .

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

Answer 2

, , . ( , , ).

, , .

, :

• if
• , /
• - .

, , ( ).

Sub CountZero()
    Dim SourceSheet As Worksheet, SummarySheet As Worksheet
    Dim CurrentCell As Range
    Dim FirstRow As Long, LastRow As Long
    Dim FirstColumn As Long, LastColumn As Long
    Dim TotalValues As Long

    Set SourceSheet = Worksheets("Sheet1")
    Set SummarySheet = Worksheets("Sheet2")

    FirstRow = 1
    LastRow = SourceSheet.Range("A" & rows.count).End(xlUp).row

    FirstColumn = 1
    LastColumn = SourceSheet.Cells(1, Columns.count).End(xlToLeft).column

    For col = FirstColumn To LastColumn
        For Rw = FirstRow To LastRow

            Set CurrentCell = SourceSheet.Cells(Rw, col)

            If CurrentCell <> 0 Then
                TotalValues = ProcessSection(CurrentCell)
                SummarySheet.Cells(Rw, col).value = TotalValues
                Rw = Rw + TotalValues
            End If

        Next Rw
    Next col
End Sub


Function ProcessSection(FirstCellWithValue As Range) As Long
    Dim Counter As Long: Counter = 0
    Do Until FirstCellWithValue.Offset(Counter, 0).value <> FirstCellWithValue.value
        Counter = Counter + 1
    Loop
    ProcessSection = Counter
End Function

, , , .