第13講 3次元ループと3次元配列による成績一覧表の高度化
第9話 成績一覧表マクロ(シート4枚版)のコード
コード例
Sub ボタン1_Click()
Dim i As Byte, j As Byte
For i = 1 To 40
For j = 1 To 5
Sheet1.Cells(6 + i, 1 + j) = Int(100 * Rnd())
Next
Next
End Sub
Sub ボタン2_Click()
f1 '生徒の合計点・平均点の計算
f2 '各教科等の合計点・平均点の計算
f3 '各生徒の合否判定
f4 '各生徒の講評
f5 '各生徒の最高点の算出
f6 '各生徒の最低点の算
f7 '各教科と合計・平均の最高点の算出
f8 '各教科と合計・平均の最低点の算出
End Sub
Function g1(t As Byte, a As Byte)
Dim i As Integer
g1 = 0
If t = 0 Then
For i = 1 To 5
g1 = g1 + Sheet1.Cells(6 + a, 1 + i)
Next
End If
If t = 1 Then
For i = 1 To 40
g1 = g1 + Sheet1.Cells(6 + i, 1 + a)
Next
End If
End Function
Sub f1()
Dim i As Byte, j As Byte
'生徒の合計点・平均点の計算
For i = 1 To 40
Sheet1.Cells(6 + i, 7) = g1(0, i)
Sheet1.Cells(6 + i, 8) = g1(0, i) / 5
Next
End Sub
Sub f2()
Dim i As Byte, j As Byte
'各教科等の合計点・平均点の計算
For i = 1 To 7
Sheet1.Cells(47, 1 + i) = g1(1, i)
Sheet1.Cells(48, 1 + i) = g1(1, i) / 40
Next
End Sub
Sub f3()
Dim i As Byte, j As Byte
'各生徒の合否判定
For i = 1 To 40
If Sheet1.Cells(6 + i, 7) >= 300 Then
Sheet1.Cells(6 + i, 11) = "合格"
End If
If Sheet1.Cells(6 + i, 7) < 300 Then
Sheet1.Cells(6 + i, 11) = "不合格"
End If
Next
End Sub
Sub f4()
Dim i As Byte, j As Byte
'各生徒の講評
For i = 1 To 40
If Sheet1.Cells(6 + i, 7) >= 350 Then
Sheet1.Cells(6 + i, 12) = "あなたはかなり優秀です。"
End If
If Sheet1.Cells(6 + i, 7) < 350 And Sheet1.Cells(6 + i, 7) >=
300 Then
Sheet1.Cells(6 + i, 12) = "おめでとう。"
End If
If Sheet1.Cells(6 + i, 7) < 300 And Sheet1.Cells(6 + i, 7) >=
200 Then
Sheet1.Cells(6 + i, 12) = "合格まで後一歩です。"
End If
If Sheet1.Cells(6 + i, 7) < 200 Then
Sheet1.Cells(6 + i, 12) = "かなりのがんばりが必要です。"
End If
Next
End Sub
Function g2(t1 As Byte, t2 As Byte, a As Byte)
Dim i As Integer
If t1 = 0 Then
g2 = 0
If t2 = 0 Then
For i = 1 To 5
If g2 < Sheet1.Cells(6 + a, 1 + i) Then g2 = Sheet1.Cells(6
+ a, 1 + i)
Next
End If
If t2 = 1 Then
For i = 1 To 40
If g2 < Sheet1.Cells(6 + i, 1 + a) Then g2 = Sheet1.Cells(6
+ i, 1 + a)
Next
End If
End If
If t1 = 1 Then
g2 = 500
If t2 = 0 Then
For i = 1 To 5
If g2 > Sheet1.Cells(6 + a, 1 + i) Then g2 = Sheet1.Cells(6
+ a, 1 + i)
Next
End If
If t2 = 1 Then
For i = 1 To 40
If g2 > Sheet1.Cells(6 + i, 1 + a) Then g2 = Sheet1.Cells(6
+ i, 1 + a)
Next
End If
End If
End Function
Sub f5()
Dim i As Byte, j As Byte
'各生徒の最高点の算出
Dim max As Integer
For i = 1 To 40
Sheet1.Cells(6 + i, 9) = g2(0, 0, i)
Next
End Sub
Sub f6()
Dim i As Byte, j As Byte
'各生徒の最低点の算出
Dim min As Integer
For i = 1 To 40
Sheet1.Cells(6 + i, 10) = g2(1, 0, i)
Next
End Sub
Sub f7()
Dim i As Byte, j As Byte
'各教科と合計・平均の最高点の算出
For i = 1 To 7
Sheet1.Cells(49, 1 + i) = g2(0, 1, i)
Next
End Sub
Sub f8()
Dim i As Byte, j As Byte
'各教科と合計・平均の最低点の算出
For i = 1 To 7
Sheet1.Cells(50, 1 + i) = g2(1, 1, i)
Next
End Sub
Sub ボタン3_Click()
Range("B7:L50").Select
Selection.ClearContents
Sheet1.Cells(1, 1).Select
End Sub
Sub ボタン4_Click()
Dim i As Byte, j As Byte
For i = 1 To 40
For j = 1 To 5
Sheet2.Cells(6 + i, 1 + j) = Int(100 * Rnd())
Next
Next
End Sub
Sub ボタン5_Click()
f11 '生徒の合計点・平均点の計算
f12 '各教科等の合計点・平均点の計算
f13 '各生徒の合否判定
f14 '各生徒の講評
f15 '各生徒の最高点の算出
f16 '各生徒の最低点の算
f17 '各教科と合計・平均の最高点の算出
f18 '各教科と合計・平均の最低点の算出
End Sub
Function g11(t As Byte, a As Byte)
Dim i As Integer
g11 = 0
If t = 0 Then
For i = 1 To 5
g11 = g11 + Sheet2.Cells(6 + a, 1 + i)
Next
End If
If t = 1 Then
For i = 1 To 40
g11 = g11 + Sheet2.Cells(6 + i, 1 + a)
Next
End If
End Function
Sub f11()
Dim i As Byte, j As Byte
'生徒の合計点・平均点の計算
For i = 1 To 40
Sheet2.Cells(6 + i, 7) = g11(0, i)
Sheet2.Cells(6 + i, 8) = g11(0, i) / 5
Next
End Sub
Sub f12()
Dim i As Byte, j As Byte
'各教科等の合計点・平均点の計算
For i = 1 To 7
Sheet2.Cells(47, 1 + i) = g11(1, i)
Sheet2.Cells(48, 1 + i) = g11(1, i) / 40
Next
End Sub
Sub f13()
Dim i As Byte, j As Byte
'各生徒の合否判定
For i = 1 To 40
If Sheet2.Cells(6 + i, 7) >= 300 Then
Sheet2.Cells(6 + i, 11) = "合格"
End If
If Sheet2.Cells(6 + i, 7) < 300 Then
Sheet2.Cells(6 + i, 11) = "不合格"
End If
Next
End Sub
Sub f14()
Dim i As Byte, j As Byte
'各生徒の講評
For i = 1 To 40
If Sheet2.Cells(6 + i, 7) >= 350 Then
Sheet2.Cells(6 + i, 12) = "あなたはかなり優秀です。"
End If
If Sheet2.Cells(6 + i, 7) < 350 And Sheet2.Cells(6 + i, 7) >=
300 Then
Sheet2.Cells(6 + i, 12) = "おめでとう。"
End If
If Sheet2.Cells(6 + i, 7) < 300 And Sheet2.Cells(6 + i, 7) >=
200 Then
Sheet2.Cells(6 + i, 12) = "合格まで後一歩です。"
End If
If Sheet2.Cells(6 + i, 7) < 200 Then
Sheet2.Cells(6 + i, 12) = "かなりのがんばりが必要です。"
End If
Next
End Sub
Function g12(t1 As Byte, t2 As Byte, a As Byte)
Dim i As Integer
If t1 = 0 Then
g12 = 0
If t2 = 0 Then
For i = 1 To 5
If g12 < Sheet2.Cells(6 + a, 1 + i) Then g12 = Sheet2.Cells(6
+ a, 1 + i)
Next
End If
If t2 = 1 Then
For i = 1 To 40
If g12 < Sheet2.Cells(6 + i, 1 + a) Then g12 = Sheet2.Cells(6
+ i, 1 + a)
Next
End If
End If
If t1 = 1 Then
g12 = 500
If t2 = 0 Then
For i = 1 To 5
If g12 > Sheet2.Cells(6 + a, 1 + i) Then g12 = Sheet2.Cells(6
+ a, 1 + i)
Next
End If
If t2 = 1 Then
For i = 1 To 40
If g12 > Sheet2.Cells(6 + i, 1 + a) Then g12 = Sheet2.Cells(6
+ i, 1 + a)
Next
End If
End If
End Function
Sub f15()
Dim i As Byte, j As Byte
'各生徒の最高点の算出
Dim max As Integer
For i = 1 To 40
Sheet2.Cells(6 + i, 9) = g12(0, 0, i)
Next
End Sub
Sub f16()
Dim i As Byte, j As Byte
'各生徒の最低点の算出
Dim min As Integer
For i = 1 To 40
Sheet2.Cells(6 + i, 10) = g12(1, 0, i)
Next
End Sub
Sub f17()
Dim i As Byte, j As Byte
'各教科と合計・平均の最高点の算出
For i = 1 To 7
Sheet2.Cells(49, 1 + i) = g12(0, 1, i)
Next
End Sub
Sub f18()
Dim i As Byte, j As Byte
'各教科と合計・平均の最低点の算出
For i = 1 To 7
Sheet2.Cells(50, 1 + i) = g12(1, 1, i)
Next
End Sub
Sub ボタン6_Click()
Range("B7:L50").Select
Selection.ClearContents
Sheet3.Cells(1, 1).Select
End Sub
Sub ボタン7_Click()
Dim i As Byte, j As Byte
For i = 1 To 40
For j = 1 To 5
Sheet3.Cells(6 + i, 1 + j) = Int(100 * Rnd())
Next
Next
End Sub
Sub ボタン8_Click()
f21 '生徒の合計点・平均点の計算
f22 '各教科等の合計点・平均点の計算
f23 '各生徒の合否判定
f24 '各生徒の講評
f25 '各生徒の最高点の算出
f26 '各生徒の最低点の算
f27 '各教科と合計・平均の最高点の算出
f28 '各教科と合計・平均の最低点の算出
End Sub
Function g21(t As Byte, a As Byte)
Dim i As Integer
g21 = 0
If t = 0 Then
For i = 1 To 5
g21 = g21 + Sheet3.Cells(6 + a, 1 + i)
Next
End If
If t = 1 Then
For i = 1 To 40
g21 = g21 + Sheet3.Cells(6 + i, 1 + a)
Next
End If
End Function
Sub f21()
Dim i As Byte, j As Byte
'生徒の合計点・平均点の計算
For i = 1 To 40
Sheet3.Cells(6 + i, 7) = g21(0, i)
Sheet3.Cells(6 + i, 8) = g21(0, i) / 5
Next
End Sub
Sub f22()
Dim i As Byte, j As Byte
'各教科等の合計点・平均点の計算
For i = 1 To 7
Sheet3.Cells(47, 1 + i) = g21(1, i)
Sheet3.Cells(48, 1 + i) = g21(1, i) / 40
Next
End Sub
Sub f23()
Dim i As Byte, j As Byte
'各生徒の合否判定
For i = 1 To 40
If Sheet3.Cells(6 + i, 7) >= 300 Then
Sheet3.Cells(6 + i, 11) = "合格"
End If
If Sheet3.Cells(6 + i, 7) < 300 Then
Sheet3.Cells(6 + i, 11) = "不合格"
End If
Next
End Sub
Sub f24()
Dim i As Byte, j As Byte
'各生徒の講評
For i = 1 To 40
If Sheet3.Cells(6 + i, 7) >= 350 Then
Sheet3.Cells(6 + i, 12) = "あなたはかなり優秀です。"
End If
If Sheet3.Cells(6 + i, 7) < 350 And Sheet3.Cells(6 + i, 7) >= 300 Then
Sheet3.Cells(6 + i, 12) = "おめでとう。"
End If
If Sheet3.Cells(6 + i, 7) < 300 And Sheet3.Cells(6 + i, 7) >= 200 Then
Sheet3.Cells(6 + i, 12) = "合格まで後一歩です。"
End If
If Sheet3.Cells(6 + i, 7) < 200 Then
Sheet3.Cells(6 + i, 12) = "かなりのがんばりが必要です。"
End If
Next
End Sub
Function g22(t1 As Byte, t2 As Byte, a As Byte)
Dim i As Integer
If t1 = 0 Then
g22 = 0
If t2 = 0 Then
For i = 1 To 5
If g22 < Sheet3.Cells(6 + a, 1 + i) Then g22 = Sheet3.Cells(6
+ a, 1 + i)
Next
End If
If t2 = 1 Then
For i = 1 To 40
If g22 < Sheet3.Cells(6 + i, 1 + a) Then g22 = Sheet3.Cells(6 + i, 1 + a)
Next
End If
End If
If t1 = 1 Then
g22 = 500
If t2 = 0 Then
For i = 1 To 5
If g22 > Sheet3.Cells(6 + a, 1 + i) Then g22 = Sheet3.Cells(6 + a, 1 + i)
Next
End If
If t2 = 1 Then
For i = 1 To 40
If g22 > Sheet3.Cells(6 + i, 1 + a) Then g22 = Sheet3.Cells(6
+ i, 1 + a)
Next
End If
End If
End Function
Sub f25()
Dim i As Byte, j As Byte
'各生徒の最高点の算出
Dim max As Integer
For i = 1 To 40
Sheet3.Cells(6 + i, 9) = g22(0, 0, i)
Next
End Sub
Sub f26()
Dim i As Byte, j As Byte
'各生徒の最低点の算出
Dim min As Integer
For i = 1 To 40
Sheet3.Cells(6 + i, 10) = g22(1, 0, i)
Next
End Sub
Sub f27()
Dim i As Byte, j As Byte
'各教科と合計・平均の最高点の算出
For i = 1 To 7
Sheet3.Cells(49, 1 + i) = g22(0, 1, i)
Next
End Sub
Sub f28()
Dim i As Byte, j As Byte
'各教科と合計・平均の最低点の算出
For i = 1 To 7
Sheet3.Cells(50, 1 + i) = g22(1, 1, i)
Next
End Sub
Sub ボタン9_Click()
Range("B7:L50").Select
Selection.ClearContents
Sheet3.Cells(1, 1).Select
End Sub
Sub ボタン10_Click()
ds '年間データ入力
f31 '生徒の合計点・平均点の計算
f32 '各教科等の合計点・平均点の計算
f33 '各生徒の合否判定
f34 '各生徒の講評
f35 '各生徒の最高点の算出
f36 '各生徒の最低点の算
f37 '各教科と合計・平均の最高点の算出
f38 '各教科と合計・平均の最低点の算出
End Sub
Sub ds()
Dim i As Byte, j As Byte
For i = 1 To 40
For j = 1 To 5
Sheet4.Cells(6 + i, 1 + j) = (Sheet1.Cells(6 + i, 1 + j) + Sheet2.Cells(6
+ i, 1 + j) + Sheet3.Cells(6 + i, 1 + j)) / 3
Next
Next
End Sub
Function g31(t As Byte, a As Byte)
Dim i As Integer
g31 = 0
If t = 0 Then
For i = 1 To 5
g31 = g31 + Sheet4.Cells(6 + a, 1 + i)
Next
End If
If t = 1 Then
For i = 1 To 40
g31 = g31 + Sheet4.Cells(6 + i, 1 + a)
Next
End If
End Function
Sub f31()
Dim i As Byte, j As Byte
'生徒の合計点・平均点の計算
For i = 1 To 40
Sheet4.Cells(6 + i, 7) = g31(0, i)
Sheet4.Cells(6 + i, 8) = g31(0, i) / 5
Next
End Sub
Sub f32()
Dim i As Byte, j As Byte
'各教科等の合計点・平均点の計算
For i = 1 To 7
Sheet4.Cells(47, 1 + i) = g31(1, i)
Sheet4.Cells(48, 1 + i) = g31(1, i) / 40
Next
End Sub
Sub f33()
Dim i As Byte, j As Byte
'各生徒の合否判定
For i = 1 To 40
If Sheet4.Cells(6 + i, 7) >= 300 Then
Sheet4.Cells(6 + i, 11) = "合格"
End If
If Sheet4.Cells(6 + i, 7) < 300 Then
Sheet4.Cells(6 + i, 11) = "不合格"
End If
Next
End Sub
Sub f34()
Dim i As Byte, j As Byte
'各生徒の講評
For i = 1 To 40
If Sheet4.Cells(6 + i, 7) >= 350 Then
Sheet4.Cells(6 + i, 12) = "あなたはかなり優秀です。"
End If
If Sheet4.Cells(6 + i, 7) < 350 And Sheet4.Cells(6 + i, 7) >=
300 Then
Sheet4.Cells(6 + i, 12) = "おめでとう。"
End If
If Sheet4.Cells(6 + i, 7) < 300 And Sheet4.Cells(6 + i, 7) >=
200 Then
Sheet4.Cells(6 + i, 12) = "合格まで後一歩です。"
End If
If Sheet4.Cells(6 + i, 7) < 200 Then
Sheet4.Cells(6 + i, 12) = "かなりのがんばりが必要です。"
End If
Next
End Sub
Function g32(t1 As Byte, t2 As Byte, a As Byte)
Dim i As Integer
If t1 = 0 Then
g32 = 0
If t2 = 0 Then
For i = 1 To 5
If g32 < Sheet4.Cells(6 + a, 1 + i) Then g32 = Sheet4.Cells(6
+ a, 1 + i)
Next
End If
If t2 = 1 Then
For i = 1 To 40
If g32 < Sheet4.Cells(6 + i, 1 + a) Then g32 = Sheet4.Cells(6 + i, 1 + a)
Next
End If
End If
If t1 = 1 Then
g32 = 500
If t2 = 0 Then
For i = 1 To 5
If g32 > Sheet4.Cells(6 + a, 1 + i) Then g32 = Sheet4.Cells(6
+ a, 1 + i)
Next
End If
If t2 = 1 Then
For i = 1 To 40
If g32 > Sheet4.Cells(6 + i, 1 + a) Then g32 = Sheet4.Cells(6
+ i, 1 + a)
Next
End If
End If
End Function
Sub f35()
Dim i As Byte, j As Byte
'各生徒の最高点の算出
Dim max As Integer
For i = 1 To 40
Sheet4.Cells(6 + i, 9) = g32(0, 0, i)
Next
End Sub
Sub f36()
Dim i As Byte, j As Byte
'各生徒の最低点の算出
Dim min As Integer
For i = 1 To 40
Sheet4.Cells(6 + i, 10) = g32(1, 0, i)
Next
End Sub
Sub f37()
Dim i As Byte, j As Byte
'各教科と合計・平均の最高点の算出
For i = 1 To 7
Sheet4.Cells(49, 1 + i) = g32(0, 1, i)
Next
End Sub
Sub f38()
Dim i As Byte, j As Byte
'各教科と合計・平均の最低点の算出
For i = 1 To 7
Sheet4.Cells(50, 1 + i) = g32(1, 1, i)
Next
End Sub
Sub ボタン11_Click()
Range("B7:L50").Select
Selection.ClearContents
Sheet4.Cells(1, 1).Select
End Sub
参考ファイル成績一覧表マクロ(シート4枚版)完成
第8話へ 第14講第1話へ
VBA講義第1部へ
vc++講義へ
vb講義へ
VB講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ
数学研究室に戻る