こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル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

投稿日時 - 2014-09-07 12:12:17

QNo.8745533

困ってます

質問者が選んだベストアンサー

こんにちは!
一例です。

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

投稿日時 - 2014-09-07 12:58:00

ANo.2

このQ&Aは役に立ちましたか?

6人が「このQ&Aが役に立った」と投票しています

-広告-
-広告-

回答(4)

ANo.4

#1、3、cjです。訂正の訂正です。

#2、編集ミスで1行抜けていました。

Sub Re8745533j() ' 最下行位置がC:AA列でマチマチの場合。
Dim tnRows ' シート全体の行数
Dim nBtmRow As Long ' 各列の最下行
Dim iCol As Long ' 列位置ループカウンタ
  tnRows = Rows.Count
  For iCol = 3 To 27 ' C:AA列相当
    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

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

投稿日時 - 2014-09-07 13:22:53

ANo.3

#1、cjです。自己レスです。

#1ふたつめの方(最下行位置がC:AA列でマチマチの場合)
を差し替えでお願いします。
結果は全く同じですが、回答主旨の一貫性に欠ける記述があった為、
2ヶ所書き換えました。

Sub Re8745533j() ' 最下行位置がC:AA列でマチマチの場合。
Dim tnRows ' シート全体の行数
Dim nBtmRow As Long ' 各列の最下行
Dim iCol As Long ' 列位置ループカウンタ
  For iCol = 3 To 27 ' C:AA列相当
    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

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

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

それでは、また。

投稿日時 - 2014-09-07 13:18:32

ANo.1

こんにちは。

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

Sub Re8745533a() ' 最下行位置がC列を基準にしてC:AA列で共通の場合。
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() ' 最下行位置がC:AA列でマチマチの場合。
Dim tnRows ' シート全体の行数
Dim nBtmRow As Long ' 各列の最下行
Dim iCol As Long ' 列位置ループカウンタ
  tnRows = Rows.Count
  For iCol = 3 To 27 ' C:AA列相当
    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

投稿日時 - 2014-09-07 12:50:15

-広告-
-広告-

あなたにオススメの質問

-広告-
-広告-