microsoft_excel:macro_sum_binary
This is an old revision of the document!
Microsoft Excel - Macro Sum Binary
' Returns the sum of all oArrWithValues for all vCrit found within the array oArrWithCrit. Function ArraySumIf(oArrWithCrit As Variant, vCrit As Variant, oArrWithValues As Variant) Dim low As Long low = LBound(oArrWithCrit) Dim high As Long high = UBound(oArrWithCrit) Dim i As Long Dim J As Long Dim result As Boolean ArraySumIf = 0 Do While low <= high i = (low + high) / 2 If vCrit = oArrWithCrit(i, 1) Then If IsNumeric(oArrWithValues(i, 1)) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) End If ' Now that found run sequentially while same value i = i + 1 J = J - 1 Do While (i <= high) If vCrit = oArrWithCrit(i, 1) Then If IsNumeric(oArrWithValues(i, 1)) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) End If i = i + 1 Else Exit Do End If Loop Do While (J >= low) If vCrit = oArrWithCrit(J, 1) Then If IsNumeric(oArrWithValues(i, 1)) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) End If J = J - 1 Else Exit Do End If Loop Exit Do ElseIf vCrit < oArrWithCrit(i, 1) Then high = (i - 1) Else low = (i + 1) End If Loop End Function
and
' Returns the sum of all oArrWithValues for all vCrit found within the array oArrWithCrit. Function ArraySumIfx(oArrWithCrit As Variant, vCrit As Variant, oArrWithValues As Variant) Dim low As Long low = LBound(oArrWithCrit) Dim high As Long high = UBound(oArrWithCrit) Dim i As Long Dim J As Long Dim result As Boolean ArraySumIf = 0 Do While low <= high i = (low + high) / 2 If vCrit = oArrWithCrit(i, 1) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) ' Now that found run sequentially while same value i = i + 1 J = J - 1 Do While (i <= high) If vCrit = oArrWithCrit(i, 1) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) i = i + 1 Else Exit Do End If Loop Do While (J >= low) If vCrit = oArrWithCrit(J, 1) Then ArraySumIf = ArraySumIf + oArrWithValues(i, 1) J = J - 1 Else Exit Do End If Loop Exit Do ElseIf vCrit < oArrWithCrit(i, 1) Then high = (i - 1) Else low = (i + 1) End If Loop
microsoft_excel/macro_sum_binary.1468236788.txt.gz ยท Last modified: 2020/07/15 09:30 (external edit)