使用VBA查找起始值，对行进行计数直到该值变为0并logging结果。 重复同一列直到数据到达

我是VBA /编码的一个新手，我通常的做法是粘贴预编写的代码，这对我的问题没有任何帮助。

我正在创build一个可以做3件事的macros：

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

对于这种情况，起始点将是单元格的值大于0的时候。 它会增加到一个常数（300）。 一旦达到300，macros将不得不计数包含数值300的行数，直到该值回到0.在工作表的单独表格中的报告计数与在新表格中的相同相对位置处input的条目就像从数据开始计数一样。 最后是循环。

我也需要做一个类似的计数，但是在水平方向（即计算一列的列数）。 如果任何人都可以为上面的垂直/行数问题创build一个代码，我真的很感激它，如果你可以注释它，所以我可以尝试理解/学习哪些代码执行每个动作，从而改变它的水平/列计数。

我附上了电子表格的屏幕截图，但作为新用户，它必须作为链接。 蓝色突出显示的表是用于我正在谈论的垂直/行计数问题的数据。 突出显示的表格下方的空白表格已经手动input了第一列数据的正确答案，以便我不希望macros在我未准确描述我的请求的情况下执行该操作。

我还附加了水平表与正确的手动input答案行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

这在我testing的有限的情况下工作（两列和几行不同的模式，这是非常基本的 – 有更多的优雅的方式来做到这一点。

 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

我正在为自己所写的内容苦苦挣扎，最终这样做了。 我给你留下了variables，用于更改表单以便读取和打印（假设您可以将结果打印到另一个表单 – 如果不是，则应该很容易更改）。

这也应该适用于你的范围内的所有单元格，假设所有框中都有值。

我用你原来的代码注意到的问题是：

1. 第一个if什么都没做
2. 我很确定你不应该在子/函数名中使用数字
3. 没有variables的大小是一个坏主意

无论如何，如果您需要任何帮助，请给我一个评论（并写出一个好的第一个问题）。

 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 

作为一个小的免责声明，我没有testing这个，让我知道是否有问题。