VBA 数式の挿入について

Question

前提・実現したいこと

CSVファイルからデータをExcelに取り込み、条件に合うデータの個数を集計するマクロを作成したいと考えています。

発生している問題・エラーメッセージ

現在はデータの個数の集計結果を表示する（図の9～11行目）ようなコードにしていますが、
図の赤枠内を変更したら変更が反映されるように、countifの数式が入るようにしたいのです。
調べてみると「Formula」を使うといいことは分かったのですが、コードの記述につまずいて
おります。宜しくお願い致します。

該当のソースコード

現在のコードを以下に記します。

Sub 考課取込()
Dim fname As Variant
Dim wb As Workbook
Dim sh As Worksheet
Dim r As Long
Dim rng As Range
fname = Application.GetOpenFilename("CSVファイル(*.csv),*.csv", MultiSelect:=False)
If VarType(fname) = vbBoolean Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Sheet1")
Set wb = Workbooks.Open(fname)
Set sh = wb.Worksheets(1)
For r = 1 To sh.Cells(Rows.Count, 1).End(xlUp).Row
.Cells(r + 1, 1).Resize(, 2).Value = sh.Cells(r, 6).Resize(, 2).Value
.Cells(r + 1, 3).Resize(, 3).Value = sh.Cells(r, 30).Resize(, 3).Value
Next r
wb.Close
.Cells(r + 2, 2).HorizontalAlignment = xlCenter
.Cells(r + 2, 2).Interior.Color = RGB(255, 242, 204)
.Cells(r + 2, 2).Value = "Ａ"
Set rng = .Range("C2:C" & .Cells(Rows.Count, 3).End(xlUp).Row)
.Cells(r + 2, 3).HorizontalAlignment = xlCenter
.Cells(r + 2, 3).Interior.Color = RGB(255, 242, 204)
.Cells(r + 2, 3).Value = WorksheetFunction.CountIf(rng, "Ａ")
Set rng = .Range("D2:D" & .Cells(Rows.Count, 4).End(xlUp).Row)
.Cells(r + 2, 4).HorizontalAlignment = xlCenter
.Cells(r + 2, 4).Interior.Color = RGB(255, 242, 204)
.Cells(r + 2, 4).Value = WorksheetFunction.CountIf(rng, "Ａ")
Set rng = .Range("E2:E" & .Cells(Rows.Count, 5).End(xlUp).Row)
.Cells(r + 2, 5).HorizontalAlignment = xlCenter
.Cells(r + 2, 5).Interior.Color = RGB(255, 242, 204)
.Cells(r + 2, 5).Value = WorksheetFunction.CountIf(rng, "Ａ")

（以下省略）

試したこと

ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

ここにより詳細な情報を記載してください。

Answer 1

特定のセル範囲が変更されたときに処理を実行するのように、C2:E7の範囲が編加工されたときに、再集計するようにWorksheet_change()イベントに集計コードを埋め込めばできるでしょう。

Comments

[sum724]

教えていただきありがとうございます。こんな方法もあるのですね。勉強になります。
一点お聞きしたいのは、その都度行数が変わる場合でも、この方法は有効なのでしょうか。今回はたまたま5人ですが、10人だったり100人だったりもするので、どのように範囲を特定したらよいでしょうか。
列数が変わることはありません。

[seastar3]

質問については、始めから反応範囲を広くとっておくか、
end(xldown)やend(xltoright)で調べたデータ範囲を反映して、activecellの座標が所定の範囲にあるかを判定してから、ふさわしい範囲で WorksheetFunction.CountIf()関数を働かせると実現可能です。

[sum724]

ご回答いただきありがとうございます。返信が遅くなってしまい申し訳ありません。
なるほど...いろんなやり方があるのですね！ネットでもいろいろ検索してはいるのですが、素人なもので、文字の羅列を見るだけでげんなりしています...。この方法でも試してみたいと思います！
ありがとうございました。

Answer 2

現状のコードが結果が正しく表示されているのなら、

.Cells(r + 2, 3).Value = WorksheetFunction.CountIf(rng, "Ａ")

上記のコードを下記に変更するだけです。

.Cells(r + 2, 3).Formula= "=COUNTIF(" & rng.Address & ", ""Ａ"")"

以降の WorksheetFunction.CountIf の部分も上記のように変更してください。

---

下記のように一気に書式と数式を設定することもできます。

'省略

    With Worksheets("Sheet1")

'省略

        With .Cells(r + 2, 2).Resize(3, 4)
            .HorizontalAlignment = xlCenter
            .Rows(1).Interior.Color = RGB(255, 242, 204)
            .Rows(2).Interior.Color = RGB(204, 255, 242)
            .Rows(3).Interior.Color = RGB(242, 204, 255)
            .Cells(1, 1).Value = "Ａ"
            .Cells(2, 1).Value = "Ｂ"
            .Cells(3, 1).Value = "Ｃ"
            .Offset(, 1).Resize(, 3).Formula = "=COUNTIF(C$3:C$" & r & ",$B" & r + 2 & ")"
        End With
    End With

矩形セル範囲に数式を設定する場合、左上のセルの数式を Formula に設定すると、右と左にオートフィルしたのと同様に数式が変換されて設定されます。

Comments

[sum724]

ご回答いただきありがとうございます。返信が遅くなってしまい申し訳ありません。
コードを変更する方法、書式と数式を一気に設定する方法、両方試してみました。どちらも自分の思い通りのものができ、思わず「お～」と声を上げてしまいました！
VBAは素人なのでだらだら書いてしまいがちですが、こうして一気に設定できるとすっきりしていいですね。大変助かりました。ありがとうございました！！