エクセルVBAで値のカウントをしたい

質問

C列～AA列まで値が入っています
1行目にはタイトル
2行目からそれぞれ値が入っており、終了行は毎回ランダムです

各列毎に値の合計と1以上の値の合計数を表示するために下記のマクロを使用しているのですが、もっとスマートな方法は無いでしょうか？
現在のマクロだとマクロ行数がとても多いものになっています。

Sub Count()

With Range("C2")
.End(xlDown).Offset(1, 0) = _
"=SUM(" & Range(.Address, .End(xlDown)).Address(False, False) & ")"
End With

'本当はCの最終行に直接COUNTIFを書き込みたいが、他のセルを使用しないと0になる
Range("A1") = "=COUNTIF(C2:C10000,"">=1"")"
Range("A1").Select
Selection.Copy
Range("C1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CommandBars("Stop Recording").Visible = False

With Range("D2")
.End(xlDown).Offset(1, 0) = _
"=SUM(" & Range(.Address, .End(xlDown)).Address(False, False) & ")"
End With

Range("A1") = "=COUNTIF(D2:D10000,"">=1"")"
Range("A1").Select
Selection.Copy
Range("D1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CommandBars("Stop Recording").Visible = False

'以降AAまでセルの位置を変えた同一マクロを繰り返す

End Sub

回答No.2

tom04 · ベストアンサー

こんにちは！
一例です。

Sub Sample1()
Dim j As Long, lastRow As Long, myRng As Range
For j = 3 To Cells(1, Columns.Count).End(xlToLeft).Column
lastRow = Cells(Rows.Count, j).End(xlUp).Row
Set myRng = Range(Cells(2, j), Cells(lastRow, j))
With Cells(lastRow + 1, j)
.Value = WorksheetFunction.Sum(myRng)
.Offset(1) = WorksheetFunction.CountIf(myRng, ">=1")
End With
Next j
End Sub

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

回答No.4

cj_mover

＃１、３、ｃｊです。訂正の訂正です。

＃２、編集ミスで１行抜けていました。

Sub Re8745533j()　'　最下行位置がＣ：ＡＡ列でマチマチの場合。
Dim tnRows　'　シート全体の行数
Dim nBtmRow As Long　'　各列の最下行
Dim iCol As Long　'　列位置ループカウンタ
　　tnRows = Rows.Count
　　For iCol = 3 To 27 '　Ｃ：ＡＡ列相当
　　　　nBtmRow = Cells(tnRows, iCol).End(xlUp).Row
　　　　Cells(nBtmRow + 1, iCol).FormulaR1C1Local = "=SUM(R2C:R[-1]C)"
　　　　Cells(nBtmRow + 2, iCol).FormulaR1C1Local = "=COUNTIF(R2C:R[-2]C,"">=1"")"
　　　　With Cells(nBtmRow + 1, iCol).Resize(2)
　　　　　　.Value = .Value
　　　　End With
　　Next iCol
End Sub

以上、訂正の訂正でした。大変失礼しました。

回答No.3

cj_mover

＃１、ｃｊです。自己レスです。

＃１ふたつめの方（最下行位置がＣ：ＡＡ列でマチマチの場合）
を差し替えでお願いします。
結果は全く同じですが、回答主旨の一貫性に欠ける記述があった為、
２ヶ所書き換えました。

Sub Re8745533j()　'　最下行位置がＣ：ＡＡ列でマチマチの場合。
Dim tnRows　'　シート全体の行数
Dim nBtmRow As Long　'　各列の最下行
Dim iCol As Long　'　列位置ループカウンタ
　　For iCol = 3 To 27 '　Ｃ：ＡＡ列相当
　　　　nBtmRow = Cells(tnRows, iCol).End(xlUp).Row
　　　　Cells(nBtmRow + 1, iCol).FormulaR1C1Local = "=SUM(R2C:R[-1]C)"
　　　　Cells(nBtmRow + 2, iCol).FormulaR1C1Local = "=COUNTIF(R2C:R[-2]C,"">=1"")"
　　　　With Cells(nBtmRow + 1, iCol).Resize(2)
　　　　　　.Value = .Value
　　　　End With
　　Next iCol
End Sub

以上、訂正です。失礼しました。

因みに、
＃２さんご提示の、WorksheetFunctionのメソッドを使う方法や、
Evaluateメソッドを使う方法、
Excel関数を使わずに純粋なVBAとしてループで求める方法
等々、色々あります。
また、＃１の回答ももう少し詰めて書くことも可能ではあります。
何を持って"スッキリ"と呼ぶか、については説明が難しい面もありますが、
私としては、結論が出ているスタイルを元に自分なりにお応えしたつもりです。

それでは、また。

回答No.1

cj_mover

こんにちは。

Excel数式を活用して、ということですと、
こんな感じにすればスッキリすると思います。
前提が確定的でないので、２種類用意しました。

Sub Re8745533a()　'　最下行位置がＣ列を基準にしてＣ：ＡＡ列で共通の場合。
Dim nBtmRow As Long　'　最下行
　　nBtmRow = Cells(Rows.Count, "C").End(xlUp).Row
　　Cells(nBtmRow + 1, "C").Resize(, 23).FormulaLocal = "=SUM(C2:C" & nBtmRow & ")"
　　Cells(nBtmRow + 2, "C").Resize(, 23).FormulaLocal = "=COUNTIF(C2:C" & nBtmRow & ","">=1"")"
　　With Cells(nBtmRow + 1, "C").Resize(2, 23)
　　　　.Value = .Value
　　End With
End Sub

Sub Re8745533j()　'　最下行位置がＣ：ＡＡ列でマチマチの場合。
Dim tnRows　'　シート全体の行数
Dim nBtmRow As Long　'　各列の最下行
Dim iCol As Long　'　列位置ループカウンタ
　　tnRows = Rows.Count
　　For iCol = 3 To 27 '　Ｃ：ＡＡ列相当
　　　　nBtmRow = Cells(tnRows, iCol).End(xlUp).Row
　　　　Cells(nBtmRow + 1, iCol).FormulaR1C1Local = "=SUM(R2C:R" & nBtmRow & "C)"
　　　　Cells(nBtmRow + 2, iCol).FormulaR1C1Local = "=COUNTIF(R2C:R" & nBtmRow & "C,"">=1"")"
　　　　With Cells(nBtmRow + 1, iCol).Resize(2)
　　　　　　.Value = .Value
　　　　End With
　　Next iCol
End Sub