|
▼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
|
|