数组不是值更新

Question

我试图通过一列值来运行，其与一个提供的字符串，如果该字符串匹配时，4列以上添加值到一个数组，则在该函数的端求和阵列。

在函数退出了（不失败）在使用ReDim保留线。

如果我评论说出来，它未能在SumArray（伯爵）线。

我在想什么？

'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

既然你迭代的范围内，你没有获得通过阵列东西。只要保持运行总计：

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值来添加字符串

Answer 2

Dim SumArray() As Variant你想REDIM变量不是一个数组。 ()表示想要变量数组。