第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話へ

004
  


VBA講義第1部へ
vc++講義へ
vb講義へ
VB講義基礎へ
初心者のための世界で一番わかりやすいVisual C++入門基礎講座へ
初心者のための世界で一番わかりやすいVisual Basic入門基礎講座へ

数学研究室に戻る