合計・平均を求めるコード No.3
行列の挿入・削除をしても計算可能で、なおかつ
途中に空白セル・空白行・空白列があっても可能

[標準モジュール module1] -----
'行列の挿入・削除をしても計算可能で、なおかつ
'途中に空白セル・空白行・空白列があっても可能
'Dim La As String
Dim La As Range
Public Lc, Lr As Integer
Sub 縦計横計()
'La = ActiveSheet.Cells. _
' SpecialCells(xlCellTypeLastCell).Address()
'
'Range("A1 :" & La).Select
'Lr = Selection.Rows.Count - 3
'Lc = Selection.Columns.Count - 4
If MsgBox("行列を 削除 しましたか?", 4) = vbYes Then
ActiveWorkbook.Save '行列削除後の最終セル認識のため再保存
End If
Set La = ActiveSheet.Cells. _
SpecialCells(xlCellTypeLastCell) '最終セル
Lr = La.Row - 3 'データ最終行
Lc = La.Column - 4 'データ最終列
For i = 1 To Lc - 2 '二列分を引算
Cells(Lr + 2, i + 2).FormulaR1C1 = _
"=SUM(R2C:R[-2]C)" '縦計
If Cells(Lr + 2, i + 2) <> 0 Then
Cells(Lr + 3, i + 2).NumberFormatLocal _
= "0.0"
Cells(Lr + 3, i + 2).FormulaR1C1 = _
"=ROUND(AVERAGE(R2C:R[-3]C), 1)" '縦平均
Else
Cells(Lr + 2, i + 2) = ""
End If
Next i
For j = 1 To Lr - 1 '一行分を引算
Cells(j + 1, Lc + 2).FormulaR1C1 = _
"=SUM(RC3:RC[-2])" '横計
If Cells(j + 1, Lc + 2) <> 0 Then
Cells(j + 1, Lc + 3).NumberFormatLocal _
= "0.0"
Cells(j + 1, Lc + 3).FormulaR1C1 = _
"=ROUND(AVERAGE(RC3:RC[-3]), 1)" '横平均
Else
Cells(j + 1, Lc + 2) = ""
End If
Next j
For p = 1 To Lr - 1
If Cells(p + 1, Lc + 2) <> "" Then
Cells(p + 1, Lc + 4).FormulaR1C1 = _
"=RANK(RC[-1], R2C[-1]:R" & Lr & "C[-1])" '順位
'この Lr に数値が入り 『" & Lr & "』 で最終行を意味する
End If
Next p
Range("A1").Select
End Sub
[標準モジュール module2] -----
Sub 結果消去()
Range(Cells(Lr + 2, 3), Cells(Lr + 3, Lc)).ClearContents
Range(Cells(2, Lc + 2), Cells(Lr, Lc + 4)).ClearContents
End Sub
allback back top