如果组值低于 10，则过滤掉整行

Question

如果值的总和超过特定数量，我会尝试从 VBA 中的电子表格中删除行。

例如，如果我有以下数据，A1中的名称和A2中的值：

我想在B行中删除A行中的值总和未达到10或以上的所有行，这将留下以下结果：

Thomas = 18 和 John = 15，所以 所有 行包含 Thomas 和 John。

所有其他行都将被删除。

请注意，我将始终知道数据在 A 行和 B 行中，但我不知道会有多少行并且需要在第一个空白单元格之前执行。

Answer 1

成功了。你可以在这里看到：

Sub run()
    Dim rowIndex, countSameRow, sumSameRow As Integer
    sumSameRow = Cells(1, 2)
    rowIndex = 2
    countSameRow = 1
    While IsEmpty(Cells(rowIndex, 1)) = False
      If (Cells(rowIndex, 1) = Cells(rowIndex - 1, 1)) Then
          sumSameRow = sumSameRow + Cells(rowIndex, 2)
          countSameRow = countSameRow + 1
      Else
          If (sumSameRow < 10) Then
              Rows(rowIndex - 1 & ":" & rowIndex - countSameRow).Delete
              rowIndex = rowIndex - countSameRow
          End If
          countSameRow = 1
          sumSameRow = Cells(rowIndex, 2)
      End If
      If IsEmpty(Cells(rowIndex + 1, 1)) Then
          If (sumSameRow < 10) Then
              Rows(rowIndex & ":" & rowIndex - countSameRow + 1).Delete
          End If
      End If
      rowIndex = rowIndex + 1
    Wend
End Sub

Answer 2

完全同意您应该先编写自己的代码，但我忍不住为您编写了一些起始代码。看看以下是否符合您的目的：

Sub Test()

Dim lr As Long, x As Long
Dim arr As Variant, rng As Range
Dim dict1 As Object: Set dict1 = CreateObject("Scripting.Dictionary")
Dim dict2 As Object: Set dict2 = CreateObject("Scripting.Dictionary")

With Sheet1 'Change according to your sheets CodeName

    'Get all of your data form A:B in memory (array)
    lr = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("A1:B" & lr)

    'Step through the array and fill up our two dictionaries
    For x = LBound(arr) To UBound(arr)
        If dict1(arr(x, 1)) <> "" Then
            dict1(arr(x, 1)) = Join(Array(dict1(arr(x, 1)), x & ":" & x), ",")
        Else
            dict1(arr(x, 1)) = x & ":" & x
        End If
        dict2(arr(x, 1)) = dict2(arr(x, 1)) + arr(x, 2)
    Next x

    'Step through our second dictionary and check if value < 10
    For Each Key In dict2.keys
        If dict2(Key) < 10 Then
            If Not rng Is Nothing Then
                Set rng = Union(rng, .Range(dict1(Key)))
            Else
                Set rng = .Range(dict1(Key))
            End If
        End If
    Next Key

    'If any where below 10, this Range object has been filled, so delete it.
    If Not rng Is Nothing Then
        rng.Delete
    End If

End With

End Sub

Answer 3

这是另一种使用 Autofilter 和 SUMIF 删除行的方法。

这假设有一个标题行，如果没有，则先添加一行。
它在 C 列中添加一个 sumif 并过滤所有小于 10 的内容，然后将其删除。
然后再次删除 C 列。

Sub filter()

    Range("C1").Value = "Sum"
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Range("C2:C" & Lastrow).Formula = "=sumif(A:A,A2,B:B)"


    Range("A2").AutoFilter ' add a filter to table
    ActiveSheet.Range("$A$1:$C$" & Lastrow).AutoFilter Field:=3, Criteria1:="<10", Operator:=xlAnd ' filter all below 10

    ActiveSheet.Range("A2:C" & Lastrow).SpecialCells(xlCellTypeVisible).EntireRow.Delete ' delete them
    Range("A1").AutoFilter ' remove filter again
    Columns("C:C").EntireColumn.Delete ' remove column C
End Sub