промежуточный итог макроса оперативных данных

Я создал таблицу данных с помощью отчетов Sharperlight, которые генерируют свои результаты в Excel, как показано ниже:

введите здесь описание изображения

Что я хочу сделать, так это разработать макрос, который будет суммировать все категории данных. Нет определенного размера длины таблицы, кроме того, что это всегда будут столбцы G - J.

Таким образом, я надеюсь, что когда пользователь обновит таблицу с помощью бокового меню, он сможет запустить макрос, чтобы быстро получить одну строку для каждой категории.

Может кто-нибудь помочь с этим???


excel vba excel-2010
person user1086159    schedule 13.06.2013    source источник
comment
как пользователи меняют значения в меню? печатать?   -  person    schedule 13.06.2013
comment
они дважды щелкают, чтобы открыть подменю для года, месяца и типа публикации. Все, что это делает, это обновляет таблицу и позволяет им фильтровать определенные особенности, такие как год.   -  person user1086159    schedule 13.06.2013
comment
какое событие запускает обновление? потому что вы можете просто добавить еще одну подпрограмму после обновления для расчета итогов   -  person    schedule 13.06.2013
comment
когда таблица обновляется, она извлекается из SQL-запроса. Без необходимости копировать и вставлять только значения, я не вижу способа подвести промежуточные итоги по группам?   -  person user1086159    schedule 13.06.2013
comment
с какой строки начинаются данные   -  person    schedule 13.06.2013
comment
заголовки - это строка 4, строка данных 5 всегда столбцы G - J   -  person user1086159    schedule 13.06.2013
comment
сводная таблица (и возможности фильтрации, которые она предлагает по умолчанию) не вариант?   -  person MikeD    schedule 13.06.2013

Ответы (1)


arrow_upward
1
arrow_downward

Щелкните правой кнопкой мыши вкладку листа1 > Просмотреть код
просмотр кода листа1
вставьте этот код

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 щелкните правой кнопкой мыши Sheet1 в Project Explorer в VBE window и 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 вниз. Выглядит так (пример версии)
results

person Community    schedule 13.06.2013
comment
Это чудесно!! Большое спасибо. если бы я хотел, чтобы промежуточные итоги отображались на отдельном листе вместо C10 и D10 вниз, достаточно ли легко это изменить? - person user1086159; 13.06.2013
comment
да. добавьте префикс Range("D" ... к Sheets("sheet name").Range("D" ... + sheets(1).Range("I" ..., и если вы хотите изменить начальную строку, обратитесь к комментарию в коде, где написано Set starting row, и измените значение строки с 10 на то, что вы хотите. Также, если вы хотите изменить столбец, используйте либо Sheets("sheet name").Cells(startAtRow, [column number here])..., либо замените буквы C и D, например, на A и B. - person ; 13.06.2013