VBA总和活动单元格顶部

我一直在试图写一个macros（我明白，这可以做到没有VBA，但它是一个更大的macros的一部分，所以宁愿它在VBA中完成），其实质上有列C中的合同名称，列E中的合同数量。所有的合同名称都分组（即苹果将全部与苹果），基本上我希望VBA净合约和负面的每个合同，并删除其他任何东西，从较高的行号开始并通过删除该行或将E列中的值更改为0，或者降低该值，从而使每个合约的累计值变为0

即

-5 -7 3 8 4 

最后将4改为1

由于所有的合同都是分组的，一旦它完成了顶层合同，为了后续的合同，我只需要检查从活动单元到顶端的总和是0而不是专门为那个合同

在所有数量都是正数的情况下，或者所有数量都是负数的情况下，它们将全部移除

在此先感谢您的帮助

Answer 1

这是否让你开始？ 我正在使用从A1开始的一系列随机数到我的样本数是A5; -5，-7,3,8,4结果将最后一个单元格更改为“1”

 Sub net_fix() Dim top As Integer Dim bottom As Long Dim running_t As Integer Dim eval As Long Dim net As Long Dim rng As Range running_t = 0 net = 0 top = 1 bottom = Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row 'last row with data (change to fit your application) Set rng = Worksheets(1).Range(Cells(top, 1), Cells(bottom, 1)) 'check for all negative or positive numbers eval = 0 For Each cell In rng If cell.Value < 0 Then eval = eval + 1 Next If eval = bottom + 1 - top Then 'all cells were negative so change value to 0 With rng .Value = 0 End With End If eval = 0 For Each cell In rng If cell.Value > 0 Then eval = eval + 1 Next If eval = bottom + 1 - top Then 'all cells were positive With rng .Value = 0 End With End If net = WorksheetFunction.Sum(rng) For i = bottom To top Step -1 'fix the cells from bottom to top until the net = 0 If Not net = 0 Then last_t = Worksheets(1).Cells(i, 1) If net > last_t Then Worksheets(1).Cells(i, 1) = 0: net = WorksheetFunction.Sum(rng) If net < last_t Then Worksheets(1).Cells(i, 1) = last_t - net: net = WorksheetFunction.Sum(rng) End If Next End Sub