1220976292 ExcelVBAです。


商品名ごとに集計をしたいのですが、毎月その月の分が追加されるので
集計するフィールド(列)を指定出来ないため、最終列(小計)まで
自動取得してから集計を実行したいのですが、どのようにすれば良いでしょうか?

・集計する範囲を自動取得(B列から最終列まで)
・最終列=小計の列

添付を例にすると、次月作成する時は「7月」分が小計列の前に入っています。
数か月先まで、毎月作成するため、列は指定せずに自動取得する方法を
教えていただけますでしょうか?

よろしくお願い致します。

回答の条件
  • 1人5回まで
  • 登録:2008/09/10 01:04:54
  • 終了:2008/09/11 21:00:14

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912008/09/10 10:15:59

ポイント100pt

とりあえず、コメントした内容でのサンプルです。

Sub CalcSum()
    Dim lastRow As Long, lastCol As Long
    lastRow = Range("A" & Rows.Count).End(xlUp).Row
    lastCol = Range("IV1").End(xlToLeft).Column
    
    Dim i As Long, j As Long, cLine As Long, pLine As Long
    Dim lastTitle As String
    
    lastTitle = Range("A2").Value
    Cells(1, lastCol + 1).Value = "小計"
    cLine = 2
    pLine = 2
    
    Do While Cells(cLine, "A").Value <> ""
'---- 行単位の小計の計算
        Cells(cLine, lastCol + 1).Formula = "=SUM(" & Range(Cells(cLine, 2), Cells(cLine, lastCol)).Address & ")"
        
'---- 列単位の小計の計算
        If Cells(cLine, "A").Value <> lastTitle Then
            Rows(cLine - 1).Copy
            Rows(cLine).Insert Shift:=xlDown
            Application.CutCopyMode = False
            
            Cells(cLine, "A").Value = Cells(cLine, "A").Value & "小計"
            Range(Cells(cLine, 1), Cells(cLine, lastCol + 1)).Interior.ColorIndex = 20
            For i = 2 To lastCol
                Cells(cLine, i).Formula = "=SUBTOTAL(9," & Range(Cells(pLine, i), Cells(cLine - 1, i)).Address & ")"
            Next
            Cells(cLine, lastCol + 1).Formula = "=SUBTOTAL(9," & Range(Cells(pLine, lastCol + 1), Cells(cLine - 1, lastCol + 1)).Address & ")"
            pLine = cLine + 1
            cLine = cLine + 1
            lastTitle = Cells(cLine, "A").Value
        End If
        cLine = cLine + 1
    Loop

'---- 総計の計算
    Cells(cLine, "A").Value = Cells(cLine, "A").Value & "総計"
    For i = 2 To lastCol + 1
        Cells(cLine, i).Formula = "=SUBTOTAL(9," & Range(Cells(2, i), Cells(cLine - 1, i)).Address & ")"
    Next
    Range(Cells(cLine, 1), Cells(cLine, lastCol + 1)).Interior.ColorIndex = 24
    
'---- 罫線の描画
    With Range(Cells(1, 1), Cells(cLine, lastCol + 1)).Borders
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
End Sub
id:hananeko_0

ご回答ありがとうございますっ

列数を色々変えて確認したところ、全て動作OKでした!

ところが、商品の3つ目(添付でいうとスナック)の小計行が挿入されず

末の商品名の小計行なしで、「総計行」が入ります。

この部分だけでしたので、自分でなんとか・・とトライしたのですが

わかりませんでした・・・

お手数ですが教えていただけますでしょうか?すいません。

2008/09/10 10:54:08
  • id:Mook
    最終列にある月までの元データがあり、それに対して最終列で行ごとの集計(小計)と
    各列に対して、同じ商品名単位で小計の行を、最終行に総計の行を追加するという
    処理でよいでしょうか。
  • id:Mook
    下記を変更してみてください。
    (1)ループの条件変更
    修正前:Do While Cells(cLine, "A").Value <> ""
        ↓
    修正後:Do While Cells(cLine - 1, "A").Value <> ""

    (2)総計の処理の修正
    修正前:Cells(cLine, "A").Value = Cells(cLine, "A").Value & "総計"
        ↓
    修正後:cLine = cLine - 1
        Cells(cLine, "A").Value = "総計"

  • id:hananeko_0
    できました!
    職場でご回答分を確認したので、早速大活躍しております。(*^_^*)

    毎回いただく回答を大切に保管し、日々勉強しています。
    VBAは深いが楽しいです。

    今回も本当にありがとうございました!

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません