Excel VBA の質問です

質問

Excel VBA でやりたいことがあるのですが、自分ではわからず困っています。。
データ例として、画像を添付しました。

実行前は、A列に名前、B列にそれぞれ選手の打点（ただし、最初の行は空白）というデータです。
これを実行後のように（A列、B列という場所は変わらずに）、それぞれの選手の打点平均を空白に算出するコードを教えてほしいです（ただし、各打点の入っていたデータはクリア）。

なお、画像例は「中田」までしか載せてませんが、その下にも続いていてデータ最後まで計算させるということをやりたいです。

ぜひ、ご教授願います。

回答No.4

tom04 · ベストアンサー

No.1・3です。

＞Averageプロパティが使えません
すなわち「AVERAGE関数」が使用できない！というコトですかね？
普通では考えられないのですが・・・

別案です。
↓のコードではどうでしょうか？
（結果的にはAVERAGE関数と同じ操作を行っています）

Sub Sample3()
Dim i As Long, cnt As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
On Error Resume Next '←おまじない
If Cells(i, "A") <> Cells(i - 1, "A") Then
cnt = i
Do While Cells(i, "A") = Cells(cnt, "A")
cnt = cnt + 1
Loop
Cells(i, "B") = WorksheetFunction.Sum(Range(Cells(i + 1, "B"), Cells(cnt - 1, "B"))) / _
WorksheetFunction.Count(Range(Cells(i + 1, "B"), Cells(cnt - 1, "B")))
Range(Cells(i + 1, "B"), Cells(cnt - 1, "B")).ClearContents
i = cnt - 1
End If
Next i
End Sub

※　AVERAGE関数でも同じコトが言えるのですが、「0」で割るという場合はエラーとなりますので、
必ずB列の範囲内には数値データがある！という前提です。

これでもダメならごめんなさいね。m(_ _)m

お礼

ばっちりできました～♪

親切に対応していただき大変ありがとうございました
仕事で必要となる作業だったのでむちゃくちゃ助かりました！

それにしても Average なんで使えなかったんだろ・・・

回答No.3

tom04

No.1です。

＞B列の空白を目印として計算させるのではなく・・・

というコトですので、
↓のコードに変更してみてください。

Sub Sample2()
Dim i As Long, cnt As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, "A") <> Cells(i - 1, "A") Then
cnt = i
Do While Cells(i, "A") = Cells(cnt, "A")
cnt = cnt + 1
Loop
Cells(i, "B") = WorksheetFunction.Average(Range(Cells(i + 1, "B"), Cells(cnt - 1, "B")))
Range(Cells(i + 1, "B"), Cells(cnt - 1, "B")).ClearContents
i = cnt - 1
End If
Next i
End Sub

※　AVERAGE関数ですので、空白セルは当然データ数としてはカウントされません。
今度はどうでしょうか？m(_ _)m

補足

ありがとうございます！

ただ、やってみたのですが、
デバックで「Averageプロパティが使えません」みたいなエラーが出てしまいます。。

こちらのバージョンとかのせいですかね・・・。

回答No.2

noname#184106

こんにちわ。
これでいかがでしょうか。

Sub Test()
Dim Rw, Rw1, RwMax As Long
RwMax = Cells(Rows.Count, 1).End(xlUp).Row
For Rw = RwMax To 2 Step -1
If Cells(Rw, 1) <> Cells(Rw + 1, 1) Then Rw1 = Rw
If Cells(Rw, 1) <> Cells(Rw - 1, 1) Then
Cells(Rw, 2) = Application.WorksheetFunction.Average(Range(Cells(Rw + 1, 2), Cells(Rw1, 2)))
Range(Cells(Rw + 1, 2), Cells(Rw1, 2)).ClearContents
End If
Next Rw
End Sub

補足

ありがとうございます！

ただ、やってみたのですが、
デバックで「Averageプロパティが使えません」みたいなエラーが出てしまいます。。

こちらのバージョンとかのせいですかね・・・。

回答No.1

tom04

こんにちは！
一例です。

1行目は項目行でデータはＡ列の2行目以降に入っているという前提です。

Sub Sample1()
Dim i As Long, cnt As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, "B") = "" Then
cnt = i + 1
Do While Cells(cnt, "B") <> ""
cnt = cnt + 1
Loop
Cells(i, "B") = WorksheetFunction.Average(Range(Cells(i + 1, "B"), Cells(cnt - 1, "B")))
Range(Cells(i + 1, "B"), Cells(cnt - 1, "B")).ClearContents
i = cnt - 1
End If
Next i
End Sub

こんな感じではどうでしょうか？m(_ _)m

補足

早速の回答大変ありがとうございます！

ただ、質問に一つ付け加えておくのを忘れてました。。
打点の列には、それぞれの名前の一番上のセルだけではなく、他にも空白（欠測値）があるのです。
たとえば、陽の33点のところが空白であったり、大引の64点が空白であったり。

ですので、B列の空白を目印として計算させるのではなく、
同じ名前のセルまでを目印として計算させるような感じでお願いしたいのです。

説明が不十分で、大変申し訳ありませんでした。
できれば何卒、よろしくお願いいたします。