Excel VBA：查找大于0的行中的第一个值，并总结以下4个单元格

作为VBA Excel的完整初学者，我希望能够做到以下几点：

我想要在一行中find第一个大于0的值，然后求和同一行中的下列4个单元格。 所以

Animal1 0 0 1 2 3 0 1 Animal2 3 3 0 1 4 2 0 Animal3 0 0 0 0 0 1 0 

结果是

 Animal1 7 Animal2 11 Animal3 1 

这可能吗？

Answer 1

（你的问题描述与你的例子不符，我把这个问题解释为总结一个以大于0的第一个数字开始的4个元素之一。如果我的解释是错误的 – 下面的代码需要被调整。）

你可以用一个用户定义的函数来实现它（例如，一个UDF–一个被devise用作电子表格函数的VBA函数）：

 Function SumAfter(R As Range, n As Long) As Variant 'Sums the (at most) n elements beginning with the first occurence of 'a strictly positive number in the range R, 'which is assumed to be 1-dimensional. 'If all numbers are zero or negative -- returns a #VALUE! error Dim i As Long, j As Long, m As Long Dim total As Variant m = R.Cells.Count For i = 1 To m If R.Cells(i).Value > 0 Then For j = i To Application.Min(m, i + n - 1) total = total + R.Cells(j) Next j SumAfter = total Exit Function End If Next i 'error condition if you reach here SumAfter = CVErr(xlErrValue) End Function 

如果您的样本数据在A1:H3则将公式=SumAfter(B1:H1,4)放入I1并复制下来将按预期工作。 请注意，代码比问题描述稍微普遍一些。 如果你打算使用VBA，你也可以尽可能的使你的subs / function更灵活。 另外请注意，如果您正在编写UDF，那么在input违反期望时，想一想您要返回哪种types的错误是个好主意。 请参阅Chip Pearson的网站 – 这是Excel VBA程序员的优秀资源。

在编辑：如果你想第一个单元格大于0join到下一个4（总共5个单元格），然后我给的function是作为原样，但使用=SumAfter(B1:H1,5)而不是=SumAfter(B1:H1,4) 。

Answer 2

这是您如何获得所需结果的变体之一：

  Sub test() Dim cl As Range, cl2 As Range, k, Dic As Object, i%: i = 1 Set Dic = CreateObject("Scripting.Dictionary") For Each cl In ActiveSheet.UsedRange.Columns(1).Cells For Each cl2 In Range(Cells(cl.Row, 2), Cells(cl.Row, 8)) If cl2.Value2 > 0 Then Dic.Add i, cl.Value2 & "|" & Application.Sum(Range(cl2, cl2.Offset(, 4))) i = i + 1 Exit For End If Next cl2, cl Workbooks.Add: i = 1 For Each k In Dic Cells(i, "A").Value2 = Split(Dic(k), "|")(0) Cells(i, "b").Value2 = CDec(Split(Dic(k), "|")(1)) i = i + 1 Next k End Sub 

Answer 3

这里是我将使用的，我不知道你使用的单元格放置，所以你将需要改变自己。

未来的参考这不是一个代码编写网站为你，如果你是新的VBA我build议先做简单的东西，使一个消息框出现，使用代码移动到不同的单元格，尝试一些如果统计和/或循环。 当你开始使用variables（布尔值，string，整数等），你会看到你能走多远。 正如我想说的，“如果你能在Excel中做到这一点，代码可以做得更好”

如果代码不起作用或不适合你的需要，那么改变它，它对我有用，当我用它，但即时通讯不是你，也没有你的电子表格

粘贴到你的VBA和使用F8一步一步地通过它看它是如何工作的，如果你想使用它。

 Sub test() [A1].Select ' assuming it starts in column A1 'loops till it reachs the end of the cells or till it hits a blank cell Do Until ActiveCell.Value = "" ActiveCell.Offset(0, 1).Select 'adds up the value of the cells going right and removes the previous cell to clean up Do Until ActiveCell.Value = "" x = x + ActiveCell.Value ActiveCell.Offset(0, 1).Select ActiveCell.Offset(0, -1).ClearContents Loop 'goes back to the begining and ends tallyed up value Selection.End(xlToLeft).Select ActiveCell.Offset(0, 1).Value = x 'moves down one to next row ActiveCell.Offset(1, 0).Select Loop End Sub