VBAプログラム（module1）では入力データを別なセルに転記するプログラムを紹介しました。
しかし、今のままでは上書きを繰り返すだけでデータの蓄積がされません。
VBAプログラム（module2）ではデータの蓄積、上書きについて紹介していきます。
データの追加
データ範囲の取得 CurrentRegion
プログラムを次のように書き換えます。
Sub Reg_07()
Dim h As integer
Dim f As integer
Set DTH = Worksheets(“Sheet1”).Range(“E1”).CurrentRegion
f = DTH.Rows.Count – 1
For h = 2 To 6
Cells(f + h, 5) = Cells(h + 2, 1) ‘氏名
Cells(f + h, 6) = Cells(2, 2) ‘科目
Cells(f + h, 7) = Cells(h + 2, 2) ‘点数
Cells(f + h, 8) = Cells(1, 2) ‘期
Next
End Sub
Set DTH = Worksheets(“Sheet1”).Range(“E1”).CurrentRegionで下の青枠の範囲がSetされます。
f = DTH.Rows.Countで青枠の範囲の行数“6”を取得しています。
7行目からデータを書き込むためFor h = 2 To 6との数合わせで”-1“をしています。
新たな科目「算数」をB2セルに入力し、B4セル以下に点数を入力して登録ボタンを押すと、以下のとおりにデータが蓄積されます。
データの上書き
上のプログラムでもう一度登録ボタンを押すと、以下の通りデータが重複します。
これを回避するために同じ期、同じ科目である場合に、上書きするように変更していまきす。
以下に一つの方法を示します。
ポイントを説明します。
str(2) = Cells(2, 2) ‘科目
期と科目を文字列としてstr(1)、str(2)に代入します。Cells(1, 2)、Cells(2, 2)そのままでも構いません。文字列が長くなる場合には変数に代入しています。、
If Cells(k, 6) = str(2) Then ‘科目
If Cells(k, 8) = str(1) Then ‘期
Range(Cells(k, 5), Cells(k, 8)).Delete Shift:=xlUp
k = k – 1
f = f – 1
End If
End If
Next
F列のデータの中でstr(2)と同じで、かつH列もstr(1)と同じ場合にセルの削除を行っています。
削除後はShift:=xlUpで上に詰めています。
f = DTH.Rows.Count – 1
削除後に改めて最終行数を取得して書き込みする行の先頭とします。
これで同じ期の同じ科目に対して上書き、それ以外はデータが蓄積されるようになりました。
画面では新しい科目、理科のデータが追加されました。
これまでのVBEの基礎を発展させて実用的なシステムを作成していきます。