Промежуточные итоги Excel 2010, VBA и ListObjects не обновляются при изменении таблицы

Итак, имея эту структуру (начиная с A1 — показать фрагмент > запустить):

table {
  border-color: #BBB;
  border-width: 0px 0px 1px 1px;
  border-style: dotted;
}
body {
  font: 12px Arial, Tahoma, Helvetica, FreeSans, sans-serif;
  color: #333;
}
td {
  border-color: #BBB;
  border-width: 1px 1px 0px 0px;
  border-style: dotted;
  padding: 3px;
}
<table>
  <tbody>
    <tr>
      <th></th>
      <th>A</th>
      <th>B</th>
      <th>C</th>
      <th>D</th>
    </tr>
    <tr>
      <td>1</td>
      <td>Title 1</td>
      <td>Title 2</td>
      <td>Title 3</td>
      <td>Title 4</td>
    </tr>
    <tr>
      <td>2</td>
      <td>GH</td>
      <td>1</td>
      <td>434</td>
      <td>4</td>
    </tr>
    <tr>
      <td>3</td>
      <td>TH</td>
      <td>3</td>
      <td>435</td>
      <td>5</td>
    </tr>
    <tr>
      <td>4</td>
      <td>TH</td>
      <td>4</td>
      <td>4</td>
      <td>6</td>
    </tr>
    <tr>
      <td>5</td>
      <td>LH</td>
      <td>2</td>
      <td>0</td>
      <td>3</td>
    </tr>
    <tr>
      <td>6</td>
      <td>EH</td>
      <td>2</td>
      <td>5</td>
      <td>36</td>
    </tr>
  </tbody>
</table>

Я написал некоторый код для преобразования этого диапазона (A1: D6) в ListObject, добавил 4 новых столбца и промежуточные итоги:

Function test()

    Dim objLO As ListObject

    Set objLO = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$D$6"), , xlYes)
    objLO.Name = "Recap"
    objLO.TableStyle = "TableStyleMedium2"

    objLO.ListColumns.Add (objLO.ListColumns.Count + 1)
    objLO.HeaderRowRange(objLO.ListColumns.Count) = "Tot1"
    objLO.ListColumns.Add (objLO.ListColumns.Count + 1)
    objLO.HeaderRowRange(objLO.ListColumns.Count) = "Tot2"
    objLO.ListColumns.Add (objLO.ListColumns.Count + 1)
    objLO.HeaderRowRange(objLO.ListColumns.Count) = "Tot3"
    objLO.ListColumns.Add (objLO.ListColumns.Count + 1)
    objLO.HeaderRowRange(objLO.ListColumns.Count) = "Tot4"

    objLO.ShowTotals = True

    objLO.ListColumns("Tot1").TotalsCalculation = xlTotalsCalculationSum
    objLO.ListColumns("Tot2").TotalsCalculation = xlTotalsCalculationSum
    objLO.ListColumns("Tot3").TotalsCalculation = xlTotalsCalculationSum
    objLO.ListColumns("Tot4").TotalsCalculation = xlTotalsCalculationSum

End Function

Теперь, если вы перейдете к любой ячейке новых столбцов и напишите несколько чисел, странно то, что ИТОГО (промежуточный итог) не обновляется; но если вы сохраните файл и снова откроете его, он будет работать, и итоги будут обновлены. Что мне не хватает?

Я уже пробовал перемещать ShowTotals после TotalCalculation, но поведение остается прежним.

Если мы теперь перестроим лист с нуля и добавим этот фрагмент кода для промежуточных итогов для столбцов b, c и d после применения стиля в предыдущем коде:

objLO.ListColumns("b").TotalsCalculation = xlTotalsCalculationSum
objLO.ListColumns("c").TotalsCalculation = xlTotalsCalculationSum
objLO.ListColumns("d").TotalsCalculation = xlTotalsCalculationSum  

Я заметил, что промежуточные итоги для b, c и d работают, но не для Tot1, Tot2 и т. д.

Кажется, что единственным обходным путем является создание необработанной таблицы перед добавлением объекта ListObject со ссылками для его создания. Кто-нибудь знает лучшее решение?

Заранее спасибо :)


person Zenigata    schedule 03.03.2015    source источник
comment
Очень умное использование фрагментов стека, +1 и добро пожаловать в ТАК!   -  person Mathieu Guindon    schedule 03.03.2015
comment
Спасибо :) Я искал способ воспроизвести структуру таблицы Excel... нашел!   -  person Zenigata    schedule 03.03.2015
comment
Вы пытались установить для общего столбца формулу, чтобы она обновлялась при изменении значения в новом столбце?   -  person FPcond    schedule 06.03.2015
comment
Я попробую это, хотя при использовании TotalsCalculation в ячейке есть формула = Subtotal ().   -  person Zenigata    schedule 06.03.2015


Ответы (2)


В таблицах Excel есть нерешенная ошибка, и есть некоторые тонкости, которые необходимо устранить, чтобы получить требуемый результат.

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

Есть 2 способа заставить Excel подсчитать итоги:

  1. Вы можете переключать состояние расчета родительского листа:

    objLO.Parent.EnableCalculation = False
    objLO.Parent.EnableCalculation = True
    
  2. Или вы можете заменить = в итоговых формулах:

    objLO.TotalsRowRange.Replace "=", "="
    

Но ни один из вышеперечисленных подходов не дает надежного решения, которое автоматически обновляет итоговые данные.

Лучшее решение...

Ключ к решению заключается в том, что промежуточные итоги вычисляются динамически для столбцов, которые существовали, когда объект ListObject был преобразован из диапазона в объект ListObject.

Вы можете использовать это знание и убедиться, что вместо добавления столбцов в конец/справа от ListObject вы вставляете их перед существующим столбцом. Но поскольку вы в конечном итоге хотите, чтобы новые столбцы были крайними справа, этот подход потребует использования фиктивного столбца в исходном диапазоне, затем все новые столбцы вставляются перед фиктивным столбцом и, наконец, столбец Dummy можно удалить.

См. этот модифицированный код с комментариями:

Function test()

    Dim objLO As ListObject

    'Expand the selection to grab an additional Dummy column
    Set objLO = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E$6"), , xlYes)
    objLO.Name = "Recap"
    objLO.TableStyle = "TableStyleMedium2"

    'Insert all of the new columns BEFORE the Dummy column
    objLO.ListColumns.Add (objLO.ListColumns.Count)
    objLO.HeaderRowRange(objLO.ListColumns.Count - 1) = "Tot1"
    objLO.ListColumns.Add (objLO.ListColumns.Count)
    objLO.HeaderRowRange(objLO.ListColumns.Count - 1) = "Tot2"
    objLO.ListColumns.Add (objLO.ListColumns.Count)
    objLO.HeaderRowRange(objLO.ListColumns.Count - 1) = "Tot3"
    objLO.ListColumns.Add (objLO.ListColumns.Count)
    objLO.HeaderRowRange(objLO.ListColumns.Count - 1) = "Tot4"

    'Must show totals BEFORE applying totals, otherwise the last column defaults to Count (even if we override it)
    objLO.ShowTotals = True

    objLO.ListColumns("Tot1").TotalsCalculation = xlTotalsCalculationSum
    objLO.ListColumns("Tot2").TotalsCalculation = xlTotalsCalculationSum
    objLO.ListColumns("Tot3").TotalsCalculation = xlTotalsCalculationSum
    objLO.ListColumns("Tot4").TotalsCalculation = xlTotalsCalculationSum

    'Remove the extra dummy column
    objLO.ListColumns(objLO.ListColumns.Count).Delete

    'Now toggle the ShowTotals to force the ListObject to recognise the new column totals
    objLO.ShowTotals = False
    objLO.ShowTotals = True

End Function
person ThunderFrame    schedule 30.03.2016
comment
Ключ к решению заключается в том, что промежуточные итоги рассчитываются динамически для столбцов, которые существовали, когда объект ListObject был преобразован из диапазона в объект ListObject. то есть! Спасибо за ваш информативный ответ. - person Zenigata; 31.03.2016
comment
Если этот ответ решит вашу проблему, пожалуйста, отметьте его как ответ, и давайте убьем этого зомби. - person ThunderFrame; 31.03.2016

Вы ничего не упускаете. Эта проблема кажется ошибкой, которую Microsoft еще не исправила.

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

person dasg7    schedule 06.03.2015
comment
Спасибо за подтверждение! - person Zenigata; 06.03.2015