Сумма определенного диапазона, который изменяется на каждой итерации цикла

Question

У меня есть лист, в котором значения диапазона меняются каждый раз, когда я меняю конкретную ячейку.Допустим, что ячейка C8 - это личность человека, а в столбце H - запланированные ежемесячные выплаты.Мне нужно найти совокупные ежемесячные выплаты, следовательно, для каждого возможного значения C8 (и это на самом деле означает для каждого человека, как вы можете думать о различных значениях C8)я строка постоянная и меняя ячейку С8, мне всегда нужно суммировать привет.Так что мне на самом деле нужна сумма (Hi) (константа i, а индекс суммы - ячейка c8, поэтому, если c8 принимает значение от 1 до 200, мне нужна сумма (Hi (c8)), снова строка I. Hi (c8)это просто обозначение, показывающее, что Hi зависит от значения c8. Фактическая формула в ячейке H10 - INDEX ('Sheet2'! R: R, MATCH ('Sheet1'! $ C $ 8, 'Sheet2'! F:F, 0)))).H11 и далее имеют одинаковую формулу с небольшими поворотами для того факта, что выплаты не всегда равны, но функция индекса остается той же.

Затем общее значение H10 для всех возможных значений c8 вставляется в c17, общее количество H11 вставляется в C18 и т. Д. Пожалуйста, найдите несколько изображений ниже, возможно, это помогает поддержать то, чего я пытаюсь достичь. введите описание изображения здесь

У меня есть следующий код для этой цели.Обратите внимание, что вышеприведенный пример был лишь для того, чтобы немного объяснить вам фон, ячейки и диапазон, который изменяется.

 sub sumloop()

 Application.ScreenUpdating = False
 Application.DisplayStatusBar = False


 Sheets("Sheet1").Range("C8").Value = 1


 Dim i, k As Integer

  i = 1


  k = Sheets("Sheet1").Range("C9").Value

  Dim LR As Long
  LR = Sheets("Sheet1").Range("C" & 
  Sheets("Sheet1").Rows.Count).End(xlUp).row

  Sheets("Sheet1").Range("C17:C" & LR).ClearContents

   Do While i <= k


   If (Sheets("Sheet1").Range("J9").Value = "") Then


           Sheets("Sheet1").Range("h10:h200").Copy
           Sheets("Sheet1").Range("c17").PasteSpecial 
    Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False


   Else


           Sheets("Sheet1").Range("h9:h200").Copy
           Sheets("Sheet1").Range("c17").PasteSpecial 
   Paste:=xlValues, Operation:=xlAdd, SkipBlanks:= _
            False, Transpose:=False


End If





 Sheets("Sheet1").Range("C8").Value = Sheets("Sheet1").Range("C8").Value+1 


  i = i + 1

  Loop

 Sheets("Sheet1").Range("C8").Value = 1

 Application.ScreenUpdating = True
 Application.DisplayStatusBar = True

 End Sub

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

Пока работает код, для 84 значений ячейки C8 требуется примерно 40 секунд, а для 250 - примерно 1,5 минуты. Я пробовал кое-что, изменил do в течение for, но ничегозначительные, используемые диапазоны переменных вместо фиксированных, таких как h10: h100, очень похоже на то, что я делаю с Sheet1.Range (C17: C & LR).Опять без существенных изменений.Поскольку я очень новичок в vba, я не знаю, много ли 1,5 минуты для такого простого кода, но мне кажется, что это много, и этот анализ необходим для 10 различных комбинаций 250 различных значений для ячейки c8, что означаетПримерно 15 минут.

Буду признателен, если кто-нибудь подскажет мне что-нибудь быстрее.

Большое спасибо заранее.

Answer 1

Как добиться того же с помощью сводных диаграмм (без VBA)

Шаг 1

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

Короче говоря, мы возьмем пример, когда у вас есть 3 клиента и 4 свидания.Таким образом, это 12 записей данных, которые обеспечат сумму погашения для каждого из возможных идентификатора клиента и даты.

Шаг 2

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

Шаг 3

Убедитесь, что все ваши данные выбранывключая верхнюю строку, которая будет определять имя каждого поля (имя каждого столбца).

Шаг 4

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

Шаг 5

Появится меню справа (возможно, оно уже было, поэтомуУбедитесь, что вы выбрали Диаграмму, а не Таблицу, поскольку это меню будет немного отличаться).

Шаг 6

Перетащите ипоместите имена полей в категории, как показано.Здесь вы говорите Excel, какие данные вы хотите видеть (значения) и как вы хотите разбить их (на дату и на одного клиента).

Шаг 7

По умолчанию для данных всегда указываются квартиль и год.Чтобы увидеть все даты, для которых у нас есть данные, вы можете щелкнуть [+] рядом с данными в Таблице: это покажет более подробную информацию как для таблицы, так и для диаграммы.

Шаг 8

Но мы хотим полностью избавиться от квартилей и лет.Для этого вам нужно щелкнуть правой кнопкой мыши любое значение столбца даты в таблице и выбрать «Разгруппировать», как показано.

Шаг 9

Ваши данные теперь выглядят так.Обратите внимание, что ось времени не в масштабе.Например, если у вас есть месячные данные, а месяц отсутствует, пропуска не будет.Это одна из трудностей с данными Pivot.Это можно преодолеть, но это не по теме.

Шаг 10

Теперь мы хотим получить кумулятивное представление оданные, поэтому мы хотим играть с тем, как значения обрабатываются в Excel.Выберите диаграмму, затем на правой панели: щелкните правой кнопкой мыши поле «Сумма погашения» и выберите «Настройки поля значения».

Шаг 11

На вкладке «Показать значения как» выберите «Показать значения как» «Запуск Tital In».Затем выберите «Дата».Здесь мы говорим Excel, что отображаемое значение должно быть кумулятивным итогом, накопленным в соответствии с полем «Дата».Нажмите ОК.

Шаг 12

Теперь у вас есть то, что вы ищете.Если вы посмотрите в таблицу, у вас есть один столбец на идентификатор клиента и одна строка на дату.На определенную Дату у вас есть накопительное погашение, сделанное с помощью данного идентификатора клиента.Справа у вас есть общая сумма, которая на определенную дату является суммой всех значений идентификатора клиента.

Шаг 13

В диаграмме отображается совокупный платеж заCUstomer ID, и мы не можем увидеть общую сумму.Чтобы достичь этого, просто удалите поле «Идентификатор клиента» из области категории «Легенда (серия)» на панели «Поля», как показано.(Вы можете снять флажок с идентификатора клиента [x] или перетащить его из области категории в основную область списка).

Шаг 14

Теперь у нас есть только общий итог в таблице. Но почему? Если вы отобразите «Настройки поля значений» суммы повторения »(шаг 10), первая вкладка« Суммировать значения по »скажет Excel, что делать, если несколько значений соответствуют одинаковым значениям легенды и оси. Теперь, когда мы удалили поле «Идентификатор клиента» из области «Легенда», для каждой даты у нас есть 3 значения погашения (по одному для каждого идентификатора клиента). В полевых настройках мы говорим Excel использовать «Sum». Таким образом, он возвращает сумму из 3 значений.

Но вы можете поиграть и вернуть Среднее или даже использовать «Счет», который покажет вам, сколько у вас записей (будет возвращено 3). Вот почему сводные диаграммы настолько мощны: всего несколько щелчков мышью и / или перетаскивание мышью позволяют отображать множество различных графиков для ваших данных.

Для дальнейшего интереса вы должны искать в Интернете фильтры и «Вставить срез» (что эквивалентно фильтрации, но добавит кнопку непосредственно на диаграмму: отлично подходит для отображения данных коллегам и переключения с одного параметра на другой)

Надеюсь, это помогло!

Answer 2

ОК, несколько вещей.

Во-первых, Dim i, k As Integer не делает то, что вы думаете, нужно делать: Dim i As Integer, k As Integer

Во-вторых, не используйте Integerв VBA используйте Long, поэтому Dim i As Long, k As Long

В-третьих, вычисления убивают вас.Выключите их с помощью Application.Calculation = xlCalculationManual в начале вашего кода и снова включите с помощью Application.Calculation = xlCalculationAutomatic в конце вашего кода.

Теперь у нас действительно быстрый код, но проблема в том, что он не обновляетсяна каждой итерации, что вам нужно сделать.Вы можете вычислить только диапазон следующим образом: Sheets("Sheet1").Range("h10:h200").Calculate, так что вставьте его перед копированием диапазона

Будет еще более быстрый способ сделать это, но я просто не могу обернуться вокругваши требования, поэтому я не могу помочь в дальнейшем.

Answer 3

Вот полное решение с пояснениями в комментариях. Поскольку у нас нет исходной электронной таблицы, я не смог запустить какие-либо тесты для этого.

Option Explicit 'This forces you to declare all your varaibles correctly. It may seem annoying at first glance, but will quickly save you time in the future.

Sub sumloop()

    Application.ScreenUpdating = False
    'Application.DisplayStatusBar = False -> This is not noticely slowing down your code as soon as you do not refresh the StatusBar value for more than say 5-10 times per second.

    'Save the existing Calculation Mode to restore it at the end of the Macro
    Dim xlPreviousCalcMode As XlCalculation
    xlPreviousCalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual

    'Conveniently store the Sheet into a variable. You might want to do the same with your cells, for example: MyCellWhichCounts = MySheet.Range("c17")
    Dim MySheet As Worksheet
    MySheet = ActiveWorkbook.Sheets("Sheet1")

    MySheet.Range("C8").Value2 = 1 'It is recommended to use.Value2 instead of .Value (notably in case your data type is Currency, but it is good practice to use that one all the time)

    Dim LR As Long
    LR = MySheet.Range("C" & MySheet.Rows.Count).End(xlUp).Row 'Be carefull with "MySheet.Rows.Count", it may go beyond your data range, for example if you modify the formatting of a cell below your "last" row.
    MySheet.Range("C17:C" & LR).Value2 = vbNullString 'It is recommended to use vbNullString instead of ""; although I agree it makes it more difficult to read.

    Dim i As Integer, k As Integer 'Integers are ok, just make sure you neer exceed 255
    k = MySheet.Range("C9").Value2
    For i = 1 To k 'Use a For whenever you can, it is easier to maintain (i.e. avoid errors and also for you to remember when you go back to it years later)

        'Little extra so you can track progress of your calcs
        Dim z As Integer
        z = 10 'This can have any value > 0. If the value is low, you will refresh your app often but it will slow down. If the value is high, it won't affect performance but your app might freeze and/or you will not have your Statusbar updated as often as you might like. As a rule of thumb, I aim to refresh around 5 times per seconds, which is enough for the end user not to notice anything.
        If i Mod z = 0 Then 'Each time i is a mutliple of z
            Application.StatusBar = "Calculating i = " & i & " of " & k 'We refresh the Statusbar
            DoEvents 'We prevent the Excel App to freeze and throw messages like: The application is not responding.
        End If

        'Set the range
        Dim MyResultRange As Range
        If (MySheet.Range("J9").Value2 = vbNullString) Then
            MyResultRange = MySheet.Range("h10:h200")
        Else
            MyResultRange = MySheet.Range("h9:h200")
        End If


        '# Extract Result Data
        MyResultRange.Calculate 'Refresh the Range values
        Dim MyResultData As Variant
        MyResultData = MyResultRange.Value2 'Store the values in VBA all at once

        '# Extract Original Data
        Dim MyOriginalRange as Range
        MyOriginalRange.Calculate
        MyOriginalRange = MySheet.Range("c17").Resize(MyResultRange.Rows.Count,MyResultRange.Columns.Count) 'This produces a Range of the same size as MyResultRange 
        Dim MyOriginalData as Variant
        MyOriginalData = MyOriginalRange.Value2

        '# Sum Both Data Arrays
        Dim MySumData() as Variant
        Redim MySumData(lbound(MyResultRange,1) to ubound(MyResultRange,1),lbound(MyResultRange,2) to ubound(MyResultRange,2))
        Dim j as long
        For j = lbound(MySumData,1) to ubound(MySumData,1)
            MySumData(j,1)= MyResultData(j,1) + MyOriginalData(j,1)
        Next j

        'Instead of the "For j = a to b", you could use this, but might be slower: MySumData = Application.WorksheetFunction.MMult(Array(1, 1), Array(MyResultData, MyOriginalData))

        MySheet.Range("C8").Value2 = MySheet.Range("C8").Value2 + 1

    Next i

 MySheet.Range("C8").Value2 = 1

 Application.ScreenUpdating = True
 Application.StatusBar = False 'Give back the status bar control to the Excel App
 Application.Calculation = xlPreviousCalcMode 'Do not forget to restore the Calculation Mode to its previous state

 End Sub

---

Добавлено OP (см. Комментарии)

Изображение 1 Код, написанный в первоначальном вопросе. введите описание изображения здесь

Изображение 2 Код выше введите описание изображения здесь

Answer 4

Добро пожаловать в StackOverflow. Я должен признать, что меня немного смутило ваше повествование, так как я не до конца понял, делаете ли вы сумму (a, b, c) или сумму (sum (a, b, c), sum (d, e, е), ...). В любом случае, хитрость, которая значительно ускорит ваш скрипт - это использование массивов.

Выполнение вычислений с помощью VBA не является медленным, но получение данных из Excel (связь с приложением) происходит медленно и в значительной степени зависит от количества «запросов», а не от количества запрашиваемых данных.

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

Dim Arr() As Variant
Arr = Range("A1:E999")

Это так просто. Попробуйте, и если вы все еще боретесь, дайте нам знать.

---

БОНУС

Если вы новичок в массивах, имейте в виду, что у вас может быть двухмерный массив:

Dim 2DArray(0 to 10, 0 to 50)

Или сложенный массив (массив массивов):

Dim MyArray() as String
Dim StackedArray() as MyArray

Dim StackedArray() as Variant

Вам потребуется 2D-массив для извлечения данных из диапазона, но я чувствую, что вам может понадобиться массив 2D-массивов для суммы сумм.

Некоторые рекомендуемые значения: https://excelmacromastery.com/excel-vba-array/