7

したがって、この構造を持つ (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$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 を追加する前に、生のテーブルを作成することです。誰もがより良い解決策を知っていますか?

前もって感謝します :)

4

2 に答える 2

2

Excel テーブルには未解決のバグがあり、必要な結果を得るために対処する必要がある微妙な点がいくつかあります。

明示的な計算トリックを使用した大まかな修正は機能しますが、このアプローチではデータ行の現在の値に基づいて合計が更新されますが、データ テーブルの値が変更されるたびに合計を適用する必要があります。

Excel で合計を計算するには、次の 2 つの方法があります。

  1. 親ワークシートの計算状態を切り替えることができます。

    objLO.Parent.EnableCalculation = False
    objLO.Parent.EnableCalculation = True
    
  2. =または、合計式の を次のように置き換えることができます。

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

しかし、上記のアプローチのいずれも、合計を自動的に最新の状態に保つ永続的なソリューションにはなりません。

より良い解決策...

解決策の手がかりは、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
于 2016-03-30T01:05:13.000 に答える
0

あなたは何も見逃していません。この問題は、Microsoft がまだ修正していないバグのようです。

今のところ試すことができる唯一のことは、コードでワークブックを保存/閉じる/再度開くことです。

于 2015-03-06T16:09:45.190 に答える