Я пытаюсь написать код VBA для создания SumIf в массиве, поскольку мой рабочий лист содержит около 200 тыс. Строк и несколько формул на других листах с использованием формулы или .WorksheetFunction.SumIf занимает слишком много времени. Кроме того, мой рабочий лист не отсортирован, так как последние строки всегда содержат самые последние добавленные данные.
В моем листе 15 столбцов, но я использую только AB C D для суммирования. A, C, D = содержит текст, а столбец B содержит числа, которые я хочу суммировать.
Я пробовал следующий код, который прекрасно работает, но занимает около 5 минут для завершения вычислений.
Dim i As Long
With Sheets("Sheet1")
x = .Cells(.Rows.Count, 1).End(xlUp).Row
For i = 2 To x
.Cells(i, 7).Value2 = Application.WorksheetFunction.SumIfs(.Range("B:B"), _
.Range("C:C"), .Range(("C") & i), _
.Range("A:A"), .Range(("A") & i), _
.Range("D:D"), .Range(("D") & i))
Next i
End With
End Sub
Я начал работать с массивом VBA, чтобы заменить sumif, поскольку это будет намного быстрее, но мне не удается заставить его работать должным образом. Код, который я использую, приведен ниже.
Dim i As Long
Dim arrRAM As Variant
Dim arrType As Variant
Dim arrR As Variant
Dim arrO As Variant
Dim arrX As Variant
Dim arrY As Variant
Dim arrD As Variant
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")
With Sheets("Sheet2")
x = .Cells(.Rows.Count, 1).End(xlUp).Row
arrRAM = .Cells(2, 2).Resize(x - 1).Value2
arrType = .Cells(2, 3).Resize(x - 1).Value2
arrR = .Cells(2, 1).Resize(x - 1).Value2
arrO = .Cells(2, 4).Resize(x - 1).Value2
arrX = .Cells(2, 5).Resize(x - 1, 2).Value2
arrY = .Cells(2, 6).Resize(x - 1).Value2
arrD = .Cells(2, 7).Resize(x - 1).Value2
For i = LBound(arrRAM, 1) To UBound(arrRAM, 1)
arrY(i, 1) = arrType(i, 1) & arrR(i, 1) & arrO(i, 1)
arrX(i, 1) = arrType(i, 1) & arrR(i, 1) & arrO(i, 1)
arrX(i, 2) = arrRAM(i, 1)
Next i
For x = LBound(arrX, 1) To UBound(arrX, 1)
dic(arrX(x, 1)) = arrX(x, 2)
Next x
tot = 0
For i = LBound(arrX, 1) To UBound(arrX, 1)
If dic.Exists(arrY(i, 1)) Then
tot = tot + arrX(i, 2)
End If
arrD(i, 1) = tot
Next i
Debug.Print arrY(1, 1)
.Cells(2, 6).Resize(UBound(arrD, 1)).Value2 = arrD
End With
End Sub
Идея заключалась в том, чтобы объединить A, C & D в один массив. Затем получите другой массив, который имеет объединенные значения + столбец B. Затем он должен найти объединенные значения из первого массива во втором (похоже, что он выполняет эту часть просто отлично), затем он должен сделать сумму.
Проблема возникает, когда мне нужно сложить значения, просто берется первое значение в столбце B, а затем добавляется следующее значение в первое. Ниже вы можете посмотреть результаты на примере данных для обычного кода SumIf Formula / First Vba и второго кода VBA.
Есть ли способ исправить мой код VBA, чтобы выводить те же результаты, что и в первой формуле one / sumif? ? Любая помощь приветствуется.
