excel - 汇总和if语句vba

我有一个产品列表及其详细信息。第2行是标题，第3行是详细信息。在E列中，我有每种产品的数量，在底部有一个总计行。每周我都会收到新数据，因此数据范围会有所不同。数据已按数量从大到小排序。

现在，我的任务是找到总数量超过我们售出总数量65％的行。这意味着我需要汇总E列中的每一行，以确定哪一行将为我带来超过总销售额的65％。

所以我写了一些vba代码，但是我代码的结果只是row3，其余的都删除了，没有错误。我正在编写vba代码，因为这是我已经编写的较大代码的一部分，所以我只发布了这部分代码。

由于数据太长（行被隐藏），因此我将数据发布在图片中，但未发布整个列表，但是您会了解我要实现的目标。从本周的数据来看，这意味着我将需要删除第18行及以下行，因为第17行是超过65％的第一行。我不需要显示J和K列，我只是通过汇总数量和列百分比的计算向您展示我的意思。

Sub test()
Dim i, j, k As Integer
Dim ValueA, ValueB As Variant
Dim lrE, c, d As Long
Dim sht As Worksheet

Set sht = Worksheets("Zip")
lrE = sht.Cells(Rows.Count, 5).End(xlUp).Row
d = sht.Range("E" & lrE)


For i = 3 To lrE - 1
    ValueA = 0.65
    ValueB = sht.Cells(i, 5).Value / d
          If ValueB <= ValueA Then
                ValueB = ValueB + sht.Cells(i, 5).Value
                i = i + 1
           End If
            If ValueB > ValueA Then
                c = sht.Cells(i, 5).Row
                    sht.Rows(c & ":" & Rows.Count).Delete
            End If

   Next i
End Sub

最佳答案

这将找到第一行等于或大于65％的行，然后删除其余行。

Sub test()

Set sht = Worksheets("Zip")
lrE = sht.Cells(Rows.Count, 5).End(xlUp).Row

tsum = WorksheetFunction.SUM(sht.Range(sht.Cells(3, 5), sht.Cells(lrE, 5)))

For i = 3 To lrE
 Sbtotal = Sbtotal + sht.Cells(i, 5).Value
    If Sbtotal / tsum > 0.65 Then
    LRow = i
    i = lrE + 1
    End If
Next i


sht.Rows(LRow + 1 & ":" & lrE).Delete

End Sub