Excel 2010,VBA 和 ListObjects 小计未在 Table 更改时更新
Excel 2010, VBA and ListObjects subtotals not updating on Table changes
因此,具有这种结构(从 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>
我编写了一些代码来转换 ListObject 中的范围 (A1:D6),添加了 4 个新列和小计:
Function test()
Dim objLO As ListObject
Set objLO = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$D"), , 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
现在,如果您继续新列的任何单元格并写入一些数字,奇怪的是 TOTAL(小计)不会更新;但如果您保存文件并重新打开它,它将起作用并且总计将更新。
我缺少什么?
我已经尝试在 TotalCalculation 之后移动 ShowTotals,但行为保持不变。
如果我们现在从头开始重建 sheet 并在应用前面代码中的样式后为 b、c 和 d 列的小计添加这段代码:
objLO.ListColumns("b").TotalsCalculation = xlTotalsCalculationSum
objLO.ListColumns("c").TotalsCalculation = xlTotalsCalculationSum
objLO.ListColumns("d").TotalsCalculation = xlTotalsCalculationSum
我注意到 b、c 和 d 的小计有效,但 Tot1、Tot2 等的小计无效
似乎唯一的解决方法是在添加带有用于创建它的引用的 ListObject 之前构造原始 table。
有人知道更好的解决方案吗?
提前致谢:)
你没有遗漏任何东西。这个问题似乎是微软尚未修复的错误。
您现在唯一可以尝试的是 Save/Close/Reopen 通过代码编写工作簿。
Excel table 中有一个突出的错误,为了获得您需要的结果,需要解决一些细微的问题。
使用显式计算技巧的粗略修复 确实有效,但是虽然这种方法会根据数据行中的当前值更新总计,但每次都需要应用它们数据 table.
中有更改的值
强制Excel计算总数的方法有2种:
您可以切换父工作表的计算状态:
objLO.Parent.EnableCalculation = False
objLO.Parent.EnableCalculation = True
或者,您可以替换总计公式中的=
:
objLO.TotalsRowRange.Replace "=", "="
但是上述两种方法都不能提供持久的解决方案,使总数保持最新自动。
更好的解决方案...
解决方案的线索在于,当 ListObject 从范围到 ListObject。
您可以利用此知识,并确保不是将列附加到 ListObject 的 end/right,而是将它们插入现有列之前。但是由于您最终希望新列位于最右边,因此这种方法需要在原始范围内使用虚拟列,然后所有新列都插入 before 虚拟列,最后,可以删除虚拟列。
查看此修改后的代码,并附上注释:
Function test()
Dim objLO As ListObject
'Expand the selection to grab an additional Dummy column
Set objLO = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$E"), , 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
因此,具有这种结构(从 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>
我编写了一些代码来转换 ListObject 中的范围 (A1:D6),添加了 4 个新列和小计:
Function test()
Dim objLO As ListObject
Set objLO = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$D"), , 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
现在,如果您继续新列的任何单元格并写入一些数字,奇怪的是 TOTAL(小计)不会更新;但如果您保存文件并重新打开它,它将起作用并且总计将更新。 我缺少什么?
我已经尝试在 TotalCalculation 之后移动 ShowTotals,但行为保持不变。
如果我们现在从头开始重建 sheet 并在应用前面代码中的样式后为 b、c 和 d 列的小计添加这段代码:
objLO.ListColumns("b").TotalsCalculation = xlTotalsCalculationSum
objLO.ListColumns("c").TotalsCalculation = xlTotalsCalculationSum
objLO.ListColumns("d").TotalsCalculation = xlTotalsCalculationSum
我注意到 b、c 和 d 的小计有效,但 Tot1、Tot2 等的小计无效
似乎唯一的解决方法是在添加带有用于创建它的引用的 ListObject 之前构造原始 table。 有人知道更好的解决方案吗?
提前致谢:)
你没有遗漏任何东西。这个问题似乎是微软尚未修复的错误。
您现在唯一可以尝试的是 Save/Close/Reopen 通过代码编写工作簿。
Excel table 中有一个突出的错误,为了获得您需要的结果,需要解决一些细微的问题。
使用显式计算技巧的粗略修复 确实有效,但是虽然这种方法会根据数据行中的当前值更新总计,但每次都需要应用它们数据 table.
中有更改的值强制Excel计算总数的方法有2种:
您可以切换父工作表的计算状态:
objLO.Parent.EnableCalculation = False objLO.Parent.EnableCalculation = True
或者,您可以替换总计公式中的
=
:objLO.TotalsRowRange.Replace "=", "="
但是上述两种方法都不能提供持久的解决方案,使总数保持最新自动。
更好的解决方案...
解决方案的线索在于,当 ListObject 从范围到 ListObject。
您可以利用此知识,并确保不是将列附加到 ListObject 的 end/right,而是将它们插入现有列之前。但是由于您最终希望新列位于最右边,因此这种方法需要在原始范围内使用虚拟列,然后所有新列都插入 before 虚拟列,最后,可以删除虚拟列。
查看此修改后的代码,并附上注释:
Function test()
Dim objLO As ListObject
'Expand the selection to grab an additional Dummy column
Set objLO = ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A:$E"), , 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