计算动态数组/范围内的小计 [英] Calculating sub totals within a Dynamic array/Range
问题描述
我有下面的数据，其中A列包含一个公式，用于从另一张工作表中提取以下数据，这样，如果原始工作表被修改，则值将被更新.
I have the data below in which column A contains a formula to pull the below data from another sheet, such that if the original sheet is modified, the values are updated.
对于每组金属，我希望创建一个小计的值，如图所示.
For each group of metals I wish to create a sub total of the values as shown.
我很欣赏excel具有小计功能，但是当我尝试实现此功能时，我收到一条错误消息，指出无法更改数组.有什么方法可以将其合并到动态数组中吗?
I appreciate that excel has a subtotal function, however when I try to achieve this I get an Error saying that the array cannot be altered. Is there any way to incorporate this into a dynamic array?
可能的VBA解决方案?在网上，我发现以下VBA代码在某种程度上产生了我所希望的效果，但是正如之前一样，它仅适用于纯数据，并且将返回相同的错误无法修改数组".如果我将其应用于提取的数据.
Possible VBA solution? Online I found the following VBA code which somewhat produced the desired affect I'm after however just as before this only works on pure data and will returns the same error "cannot amend array" if I apply this to pulled data.
Sub ApplySubTotals()
Dim lLastRow As Long
With ActiveSheet
lLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If lLastRow < 3 Then Exit Sub
.Range("E5:M" & lLastRow).Subtotal GroupBy:=1, _
Function:=xlSum, TotalList:=Array(1, 2), _
Replace:=True, PageBreaks:=False, SummaryBelowData:=True
End With
End Sub
作为完全不熟悉VBA的人，我不确定将代码应用于动态数组时有多大帮助.
As someone completely unfamiliar with VBA I'm not sure how helpful this is code is when applied to a dynamic array.
如果任何人都想出一种方法来使用VBA或通过修改创建动态数组的公式(如上图所示)来获得所需输出(如上图所示)(不确定仅使用公式是否可以实现)，不胜感激.
If anyone could think of a way to achieve the desired output as shown in the image above either using VBA or even better by amending the formula that creates the dynamic array (not sure if this is possible with just formulas), It would be appreciated.
推荐答案
简短的解决方案说明:
您可以使用几个数组和一个字典来完成整个操作.使用字典按元素分组，然后为关联的值提供一个数组.该数组到目前为止将对该元素遇到的值进行一维连接(使用定界符，以便稍后拆分)，而二维则是累积总数.
You could do the whole thing with a couple of arrays and a dictionary. Use the dictionary to group by element, and then have an array for the associated value. The array would have 1D as concatenation of values encountered so far for that element (with a delimiter to later split on), 2D as being the cumulative total.
注意:
- 这种方法不假定您的输入是有序的，因此可以处理无序的输入.
- 使用数组的优点是速度.使用数组要比产生循环中反复触摸工作表的开销要快得多.
需要图书馆参考:
需要通过VBE对Microsoft脚本运行时的引用.工具>参考.请参阅说明结尾的链接.
Requires a reference to Microsoft Scripting Runtime via VBE > Tools > References. See link that explains how at end.
VBA:
Option Explicit
Public Sub ApplySubTotals()
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
If lastRow < 4 Then Exit Sub
Dim arr(), dict As Scripting.Dictionary, i As Long
arr = .Range("A4:B" & lastRow).Value
Set dict = New Scripting.Dictionary
For i = LBound(arr, 1) To UBound(arr, 1)
If Not dict.Exists(arr(i, 1)) Then
dict(arr(i, 1)) = Array(arr(i, 2), arr(i, 2))
Else
dict(arr(i, 1)) = Array(dict(arr(i, 1))(0) & ";" & arr(i, 2), dict(arr(i, 1))(1) + arr(i, 2))
End If
Next
ReDim arr(1 To lastRow + dict.Count - 3, 1 To 2)
Dim key As Variant, r As Long, arr2() As String
For Each key In dict.Keys
arr2 = Split(dict(key)(0), ";")
For i = LBound(arr2) To UBound(arr2)
r = r + 1
arr(r, 1) = key
arr(r, 2) = arr2(i)
Next
r = r + 1
arr(r, 1) = "Subtotal": arr(r, 2) = dict(key)(1)
Next
.Cells(4, 4).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
End With
End Sub
旁注:
如下所示，更新与每个键相关联的数组中的项可能更有效:
It may be possible that it is more efficient to update items within the array associated with each key as follows:
If Not dict.Exists(arr(i, 1)) Then
dict(arr(i, 1)) = Array(arr(i, 2), arr(i, 2))
Else
dict(arr(i, 1))(0) = dict(arr(i, 1))(0) & ";" & arr(i, 2)
dict(arr(i, 1))(1) = dict(arr(i, 1))(1) + arr(i, 2)
End If
我将在有更多时间的时候进行测试.
I will need to test when I have more time.
想了解更多吗?
作为初学者，以下是一些有用的链接:
As a beginner, here are some useful links:
