Массив не обновляется значениями - PullRequest
0 голосов
/ 04 февраля 2019

Я пытаюсь просмотреть столбец значений, сравнить его с предоставленной строкой, если она соответствует строке, добавить столбцы значений 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

Ответы [ 2 ]

0 голосов
/ 04 февраля 2019

Поскольку вы перебираете диапазон, вы ничего не получаете, используя массив.Просто сохраняйте промежуточный итог:

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 значения для добавления

0 голосов
/ 04 февраля 2019

Dim SumArray() As Variant вы пытаетесь переделать переменную, а не массив.() указывает, что вы хотите массив вариантов.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...