vba - 小計を複数の列に表示する

Question

私がやろうとしているのは、作成されたすべての小計の値が1である場合に合計することです。小計オプションを使用してみましたが、機能させることができず（Excelの使用が苦手なためか）、合計を使用してグループで0と1を取得することがあります。そこで、VBAを作成することにしました。

これはほとんどデータのグループです

- |    A    |    B    |  C  |
-----------------------------
1 | Names   | Points  |  N  |
-----------------------------
2 | Grimer  |   1     |  88 |
3 | Grimer  |   1     |  88 |
4 | Grimer  |   0     |  88 |
5 | Psyduck |   1     |  54 |
6 | Psyduck |   0     |  54 |
7 | Psyduck |   0     |  54 |
8 | Pikachu |   1     |  25 | 
9 | Pikachu |   1     |  25 |
10| Pikachu |   1     |  25 |

そして、これは私が取得しようとしているものです：

     |    A    |    B    |  C  |
-------------------------------
   1 | Names   | Points  |  N  |
-------------------------------
|  2 | Grimer  |   1     |  88 |
|  3 | Grimer  |   1     |  88 |
|  4 | Grimer  |   0     |  88 |
-  5 | Grimer  |   2     |  88 |
|  6 | Psyduck |   1     |  54 |
|  7 | Psyduck |   0     |  54 |
|  8 | Psyduck |   0     |  54 |
-  9 | Psyduck |   1     |  54 |
|  10| Pikachu |   1     |  25 | 
|  11| Pikachu |   1     |  25 |
|  12| Pikachu |   1     |  25 |
-  13| Pikachu  |   3     |  25 |

すべての行の先頭（2から始まる）で破線で示されているのは、作成したいグループです（すべての行のBセルが結果です。太字にする必要があります）。次のコードは、前の結果（テーブル）を取得するためのものです。それは動作しますが、プログラミングなしでExcelでそれを行うより良い解決策があるかどうか知りたいです。または...実行すると数秒かかるため（4000行以上の場合）、エラーはありますか？

Sub GetPointsByPokemon()

    With ThisWorkbook.ActiveSheet

        Dim Fila As Integer, InitRow As Integer, Suma As Integer

        PkNumber = .Range("C2").Value
        InitRow = 2
        ActualRow = 2
        Suma = 0

        Do Until .Cells(ActualRow, 1).Value = ""
            If .Cells(ActualRow, 2).Value = 1 Then
                Suma = Suma + 1
            End If

            If PkNumber <> .Range("C" & (ActualRow + 1)).Value Then
                .Cells(ActualRow, 1).Offset(1).EntireRow.Insert
                PkNumber = .Range("C" & (ActualRow + 2)).Value

                .Range(ActualRow & ":" & ActualRow).Offset(1).Value = .Range(ActualRow & ":" & ActualRow, 1).Value

                .Range("B" & (ActualRow + 1)).Value = Suma
                .Rows(InitRow & ":" & ActualRow).Group

                ActualRow = ActualRow + 1
                InitRow = ActualRow + 1
                Suma = 0
            End If

            ActualRow = ActualRow + 1
        Loop

    End With
End Sub

すべてのデータは一例であり、コードのいくつかの値を変更する必要がありました。MySQLを使用して実行しましたが、Excel（およびvba）で実行する方法を本当に知りたいです。よろしくお願いします。

Answer 1

個人的には、フシギダネが好きです。

小計をワークシートにハードコーディングし、それらをソースデータに織り込んでいるため、このアプローチも好きではありません。

しかし、それでもこれを実行したい場合は、ここにコードがあります。それは醜いですが、それは動作します。

Sub AddSubtotals()

  Dim i As Long
  Dim numberOfRows As Long

  ' number of pokemon
  numberOfRows = Cells(Rows.Count, "A").End(xlUp).Row

  ' do bottom row first
  Cells(numberOfRows + 1, 1).value = Cells(numberOfRows, 1).value
  Cells(numberOfRows + 1, 2).FormulaR1C1 = "=SUMIF(R[-" & numberOfRows - 1 & "]C[-1]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[-1],""" & Cells(numberOfRows, 1).value & """,R[-" & numberOfRows - 1 & "]C[0]:R[-" & numberOfRows - (numberOfRows - 1) & "]C[0])"
  ' convert to value
  Cells(numberOfRows + 1, 2).value = Cells(numberOfRows + 1, 2).value
  Cells(numberOfRows + 1, 3).value = Cells(numberOfRows, 3).value

  Range(Cells(numberOfRows + 1, 1), Cells(numberOfRows + 1, 3)).Font.Bold = True

  ' insert blank row in between each group of pokemon
  ' loop backwards because we are inserting rows
  For i = numberOfRows To 3 Step -1
    If Cells(i, 1).value <> Cells(i - 1, 1).value Then
      Cells(i, 1).EntireRow.Insert xlShiftDown

      ' copy pokemon name down
      Cells(i, 1).value = Cells(i - 1, 1).value

      ' put formula into Points field
      Cells(i, 2).FormulaR1C1 = "=SUMIF(R[-" & i - 1 & "]C[-1]:R[-" & i - (i - 1) & "]C[-1],""" & Cells(i, 1).value & """,R[-" & i - 1 & "]C[0]:R[-" & i - (i - 1) & "]C[0])"
      ' convert to value
      Cells(i, 2).value = Cells(i, 2).value

      ' copy N value down
      Cells(i, 3).value = Cells(i - 1, 3).value

      Range(Cells(i, 1), Cells(i, 3)).Font.Bold = True

    End If
  Next i

End Sub

コード前のサンプルデータ：

コード後のサンプルデータ：

Answer 2

VBAなしの1つの方法：

1. データを選択| 小計...の各変更時：Names 関数を使用：Sum、チェック：PointsおよびN。

2. 列Cを選択し、小計式のを（Ctrl + H）を（平均）、（最大） 、（最小）9,などの別の要約関数に置き換えることを選択します。 1,4,5,