VBA将活动单元格汇总到顶部

Question

我一直在尝试编写一个宏（我很欣赏这可以在没有VBA的情况下完成，但它是一个更大的宏的一部分，所以更像是在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