Excel 2010,VBA和ListObjects小计不更新表更改

时间:2015-03-03 19:58:37

标签: vba excel-2010 subtotal listobject

所以,有了这个结构(从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>
&#13;
&#13;
&#13;

我编写了一些代码来转换ListObject中的范围(A1:D6),添加了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

现在,如果你继续使用新列的任何单元格并写一些数字,奇怪的是TOTAL(小计)不会更新;但是如果您保存文件并重新打开它,它将起作用,总计将更新。 我错过了什么?

我已经尝试在TotalCalculation之后移动ShowTotals,但行为保持不变。

如果我们现在从头开始重建工作表,并在应用上一代码中的样式后为列b,c和d添加这段代码:

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

我注意到b,c和d的小计正在工作,但不适用于Tot1,Tot2等。

似乎唯一的解决方法是在添加带有创建它的引用的ListObject之前构造原始表。 有人知道更好的解决方案吗?

提前致谢:)

2 个答案:

答案 0 :(得分:2)

Excel表格中存在一个突出的错误,需要解决一些细微之处才能获得所需的结果。

使用显式计算技巧的粗略修复确实有效,但是此方法会根据数据行中的当前值更新总计,但每次更改值时都需要应用它们数据表。

有两种方法可以强制Excel计算总数:

  1. 您可以切换父工作表的计算状态:

    objLO.Parent.EnableCalculation = False
    objLO.Parent.EnableCalculation = True
    
  2. 或者,您可以替换总计公式中的=

    objLO.TotalsRowRange.Replace "=", "="
    
  3. 但上述两种方法都没有为您提供持久的解决方案,使总数保持最新状态自动

    更好的解决方案......

    解决方案的线索在于,当ListObject从一个范围转换为ListObject时,为存在的列动态计算小计

    您可以利用这些知识,并确保不将列附加到ListObject的结尾/右侧,而是将它们插入现有列之前。但是,由于您最终希望新列最右边,这种方法需要在原始范围内使用虚拟列,然后在列之前插入所有新列,最后,可以删除虚拟列。

    请参阅此修改后的代码,注释:

    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
    

答案 1 :(得分:0)

你没有遗漏任何东西。这个问题似乎是微软尚未修复的错误。

您现在唯一可以尝试的是按代码保存/关闭/重新打开工作簿。