在实时数据macros上进行小计

我已经通过Sharperlight报告创build了一个数据表,它将结果生成为excel,如下所示:

在这里输入图像说明

我想要做的是开发一个macros,将所有类别的数据小计。 没有确定的长度大小的表,除了它总是列G – J.

这样,我希望当用户使用侧面的菜单刷新表时,他们将能够运行一个macros,为每个类别获得快速的一行。

有人能帮忙吗???

右键单击“工作表1”选项卡>“查看代码”
sheet1查看代码
粘贴这个代码

Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 4 Then If Target.Row = 4 Or Target.Row = 5 Or Target.Row = 6 Then Totals End If End Sub 

然后添加一个module ,在VBE windowProject Explorer中右键单击Sheet1 ,然后Insert > Module
然后指定此代码

 Sub Totals() Range("C10:D" & Range("C10:C" & Rows.Count).End(xlDown).Row).ClearContents Dim startAtRow As Long startAtRow = 10 ' Set starting row Dim lr As Long, i As Long, j As Long lr = Range("J" & Rows.Count).End(xlUp).Row ReDim arr(lr - 4) As String For i = 5 To lr arr(i - 5) = Range("J" & i).Value Next i Dim arr2() As String arr2 = arr RemoveDuplicate arr For i = LBound(arr) To UBound(arr) - 1 Range("C" & (i + startAtRow)).Value = arr(i) For j = LBound(arr2) To UBound(arr2) - 1 If arr(i) = arr2(j) Then Range("D" & (i + startAtRow)).Value = Range("D" & i + startAtRow).Value + Range("I" & (j + 5)).Value End If Next j Next i End Sub Private Sub RemoveDuplicate(ByRef StringArray() As String) Dim lowBound$, UpBound&, A&, B&, cur&, tempArray() As String If (Not StringArray) = True Then Exit Sub lowBound = LBound(StringArray): UpBound = UBound(StringArray) ReDim tempArray(lowBound To UpBound) cur = lowBound: tempArray(cur) = StringArray(lowBound) For A = lowBound + 1 To UpBound For B = lowBound To cur If LenB(tempArray(B)) = LenB(StringArray(A)) Then If InStrB(1, StringArray(A), tempArray(B), vbBinaryCompare) = 1 Then Exit For End If Next B If B > cur Then cur = B: tempArray(cur) = StringArray(A) Next A ReDim Preserve tempArray(lowBound To cur): StringArray = tempArray End Sub 

现在,每当用户更改D4,D5,D6的值时,结果都应该更新。 类别将从C10开始显示,D10开始显示。 看起来像这样(样本版本)
结果