Question

我试图遍历一列值，将其与提供的字符串进行比较，如果它与字符串匹配，则将值4列加到数组中，然后在函数末尾求和该数组。

该函数在ReDim Preserve行退出（不会失败）。

如果我将其注释掉，它将在SumArray（Count）行失败。

我想念什么？

'Function used to SUM 
 Public Function TotalSum(prefix As String, rng As Range) As Integer
 Dim BookofDaveSum As Dictionary
 Set BookofDaveSum = New Dictionary
 Dim SumArray As Variant
 Dim Count As Long

 Dim cell As Range
 Dim i As Integer

Count = 0

 For Each cell In rng
    If Left(cell.Value, 7) = prefix Then
        If Not BookofDaveSum.Exists(cell.Value2) Then
            BookofDaveSum.Add cell.Value2, 0
            ReDim Preserve SumArray(0 To Count)
            SumArray(Count) = cell.Offset(0, 4)
            Count = Count + 1
        End If
    End If
 Next cell

TotalSum = Application.WorksheetFunction.Sum(SumArray)

End Function

Answer 1

Dim SumArray() As Variant，您正在尝试重新格式化变量而不是数组。 ()表示您需要一系列变体。

Answer 2

由于要遍历范围，因此使用数组不会获得任何收益。只需保持运行总计：

Public Function TotalSum(prefix As String, rng As Range) As Integer

Dim BookofDaveSum As Dictionary
Set BookofDaveSum = New Dictionary

Dim cell As Range
For Each cell In rng
   If Left(cell.Value, 7) = prefix Then
       If Not BookofDaveSum.Exists(cell.Value2) Then
           TotalSum = TotalSum + cell.Offset(0, 4).Value2
       End If
   End If
Next cell

End Function

如果您关注速度，则将两个范围都转换为数组并迭代数组：

Public Function TotalSum(prefix As String, rng As Range) As Long

Dim BookofDaveSum As Dictionary
Set BookofDaveSum = New Dictionary

Dim chRng As Variant
chRng = rng.Value2

Dim addRng As Variant
addRng = rng.Offset(, 4).Value2

Dim temp As Long
temp = 0

Dim i As Long
For i = LBound(chRng, 1) To UBound(chRng, 1)
   If Left(chRng(i, 1), 7) = prefix Then
       If Not BookofDaveSum.Exists(chRng(i, 1)) Then
           temp = temp + addRng(i, 1)
       End If
   End If
Next cell

TotalSum = temp

End Function

这也可以通过公式来完成：

=SUMPRODUCT(((LEFT(A1:A10,7)="abcdefg")*(E1:E10))/(COUNTIFS(A1:A10,A1:A10,A1:A10,"abcdefg" &"*")+(LEFT(A1:A10,7)<>"abcdefg")))

其中abcdefg是您的前缀，A1:A10是要测试的字符串，E1:E10是要添加的值

数组未使用值更新

2 个答案: