| 
    
     |  | ▼Hirofumi さん,こんにちは。 ご回答ありがとうございました。ご教授の内容をもとに、私のファイルへ当てはめ、少し、加工しましたが、うまくいきません。以下の様な、内容ではまずいのでしょうか?ちなみに、以前、ご紹介しましたエクセルの表を若干、加工した表を使います。申し訳ありませんが、またのご教授をお願い致します。
 
 ・1〜3行は文字列(**で入力しておきます。)が、4〜5行は空白、6行目は 項目名(B〜K列、入力は省略してます。)です。
 ・前回ご紹介したエクセルの表の日付(20040402など)を、その対象となるデータ のB列へ貼り付けています。(後で、オートフィルタをかけるためです。)
 ・A列7行目以降は、項目名になります。
 ・集計する列は、F〜H列の数値であり、小計をF〜H列の10行目と16行目に、合 計をF〜H列の17行目に表示させ、なおかつ、件数の小計もE列10行目と16行目 に、合計をE列16行目に集計させます。
 ・前述で説明しましたとおり、サンプル表は、1〜3行目の文字列、B列の日付、 F〜H列の数値だけ入力しています。
 
 A_B_C_D_E_F_G_H_I_J_K_L_M_N_O_P_Q_R_S_T_U_V_W__  1***______________________________
 2***_______________________________
 3***________________________________
 4_________________________________
 5____________________________________
 6___________________________________
 7_20040401__100_10_1000________________________
 8_20040401__200_20_2000________________________
 9_20040401__300_30_3000____________________    10____________________________________11____________________________________12_20040402__100_10_1000________________________13_20040402__200_20_2000________________________14_20040402__300_30_3000________________________15_20040402__400_40_4000________________________16________________________________17_____________________________________________
 
 
 Option Explicit
 
 Public Sub AddUp()
 
 Dim i As Long
 Dim j As Long
 Dim lngListTop As Long
 Dim lngListEnd As Long
 Dim vntData As Variant
 Dim vntSum(1) As Variant
 Dim vntSubSum(1) As Variant
 
 With ActiveSheet
 '仮に先頭行を設定
 lngListTop = 4
 'もし、先頭行B列が""なら
 If .Cells(lngListTop, "A").Value = "" Then
 '先頭行を取得
 lngListTop = .Cells(lngListTop, "A").End(xlDown).Row
 End If
 '最終行を取得
 lngListEnd = .Cells(65536, "E").End(xlUp).Row + 1
 '先頭行から最終行まで繰り返し
 For i = lngListTop To lngListEnd
 '現在行のA、F、G、H列の値を取得
 vntData = .Cells(i, "A").Resize(, 7).Value
 'もし、A列が""でF列が""なら(日付の終り)
 If vntData(1, 1) = "" Then
 '小計を出力
 .Cells(i, "F").Resize(, 3).Value = vntSubSum
 '小計を計に加算
 For j = 0 To 1
 vntSum(j) = vntSum(j) + vntSubSum(j)
 Next j
 Else
 'もし、A列が""で無いなら(日付が有る場合)
 If vntData(1, 1) <> "" Then
 '小計をクリア
 For j = 0 To 1
 vntSubSum(j) = 0
 Next j
 Else
 '小計にF列値、G列値、H列値及びカウントを加算
 vntSubSum(0) = vntSubSum(0) + 1
 vntSubSum(1) = vntSubSum(1) + vntData(1, 5)
 vntSubSum(2) = vntSubSum(2) + vntData(1, 6)
 vntSubSum(3) = vntSubSum(3) + vntData(1, 7)
 End If
 End If
 Next i
 '計を出力
 .Cells(i, "E").Resize(, 4).Value = vntSum
 End With
 
 Beep
 MsgBox "処理完了"
 
 End Sub
 
 
 |  |