有条件地对值范围求和

Question

我想对一个值范围求和，不包括同一行中另一个单元格包含指定值的单元格。

我需要使用VBA在Excel中执行以下实现。

我在以下示例中报告了以下数据：

我需要几天的总和，但不包括“测试”所需的天数。

我知道 offSet 可以执行类似的操作，但是，“测试”可以随机插入到任何字段中，因此，我需要动态计算。

所需的输出为16。

Answer 1

在此示例中，我使用的Sheet1的动态范围从A2到LastRow。

尝试：

Sub Test()
    Dim LR As Long
    Dim Total As Variant

    With Worksheets("Sheet1")
         LR = .Cells(.Rows.Count, "A").End(xlUp).Row
         Total = Application.WorksheetFunction.SumIf(.Range("A2:A" & LR), "<>Test", .Range("B2:B" & LR))
    End With
End Sub

Answer 2

数组输给SumIf

最有趣的是，这条线需要更长的时间

vntArr = objRng

（即将范围粘贴到数组中）而不是整个SumIf Code完成。

在一百万行中，“ Array”版本所用的时间少于4秒，而“ SumIf”版本所用的时间少于1.5秒。

'*******************************************************************************
'Purpose:   Sums up a range of values excluding the values of cells where
'           another cell in the same row contains a specified value.
'*******************************************************************************
Sub SumifArray()

  Const cstrName As String = "Sheet1" 'Name of the worksheet to be processed
  Const cLngFirstRow As Long = 2 'First row of data (excluding headers)
  Const cStrSumColumn As String = "B" 'The column to sum up
  Const cStrCheckColumn As String = "A" 'The column where to check against
  Const cStrCheckString As String = "Test" 'The value to be checked against

  Dim objRng As Range 'The range of data (both columns)
  Dim vntArr As Variant 'The array where the range is to be pasted into
  Dim lngLastRowCheck As Long 'Calculated last row of data in the "check" column
  Dim lngLastRowSum As Long 'Calculated last row of data in the "sum" column
  Dim lngArrCounter As Long 'Array row counter
  Dim lngSum As Long 'Value accumulator

  With Worksheets(cstrName)
    ' Last used row in column cStrCheckColumn
    lngLastRowCheck = .Columns(cStrCheckColumn).Find(What:="*", _
        After:=.Cells(1, cStrCheckColumn), LookIn:=xlFormulas, _
        Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    ' Last used row in column cStrSumColumn
    lngLastRowSum = .Columns(cStrSumColumn).Find(What:="*", _
        After:=.Cells(1, cStrSumColumn), LookIn:=xlFormulas, _
        Lookat:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
  End With

  ' Calculate the range of data
  Set objRng = Range(Cells(2, cStrCheckColumn), _
      Cells(lngLastRowCheck, cStrSumColumn))
  ' Paste the range of data into an array (One-based, two-dimensional)
  vntArr = objRng
  ' Release object variable: the data is in the array
  Set objRng = Nothing

  ' Loop through the array
  For lngArrCounter = LBound(vntArr) To UBound(vntArr)
    ' Check if the value in the "check" column isn't equal to cStrCheckString
    If vntArr(lngArrCounter, 1) <> cStrCheckString Then _
        lngSum = lngSum + vntArr(lngArrCounter, 2)
  Next

  ' Write the result into the first empty row after the last row of data in
  ' the "sum" column
  Worksheets(cstrName).Cells(lngLastRowSum + 1, cStrSumColumn) = lngSum

End Sub

Answer 3

另一种代码，您可以在其中选择不加总的项目：

示例：执行宏之前

在此示例中，您选择了项目（活动单元格），我选择了B（总数为20-B值（3）= 17），执行得到的宏：

代码段为：

Sub test()
'i suppose the name are on the A coloumn and the value are in b coloumn
Dim rows As Integer
Dim sum As Double

sum = 0

'count how many rows
rows = ActiveSheet.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).count

For i = 2 To rows

    'sum the value
    sum = sum + Cells(i, 2) 'column B value

Next i

'subtract the item focused
sum = sum - Cells(ActiveCell.Row, 2)

'write sum in the last row (column B)
Cells(rows + 1, 2) = sum

End Sub