ポムさんのプログラミング奮闘日記

ポムさんのプログラミング奮闘日記

VBAで作ったツールやプログラミングに関することを書きます

テスト結果を集計(セル範囲を配列へ一括格納/配列内を走査し計算処理後に別の配列へ格納)


点数一覧で使用している氏名は、全て下記のサイトを利用して疑似的に生成したものであり、実際のものではありません。
https://hogehoge.tk/personal/generator/
また、点数についても適当に入力したものであり、実際の個人のものではありません。

今回は配列を使った処理について書いてみました!
やることはタイトルにも書いたけど、次の3つになります。
1)セル範囲を配列へ一括格納
2)配列内を走査し、計算処理後に別の配列へ格納
3)配列の内容をセルへ一気に出力

今回使用するのは
学生番号、氏名、国語、英語、数学、理科、社会、合計点の全8項目を含む一覧表
学生別の全合計を出力します。そんなの、ワークシート関数SUMで俺でもできるじゃん!って言われそうですが・・・・(笑)

f:id:Tompsom:20200202104911p:plain
試験結果

1.変数の宣言と科目数のカウント

Option Explicit

Sub 配列を使ってテスト集計()

Dim iRowsCnt         As Long    '行カウンタ
Dim iColCnt          As Long    '列カウンタ
Dim iSubjectsCnt     As Long    '科目数カウンタ
Dim iStudentCnt      As Long    '学生数カウンタ(合計点を配列 arrTotalScore に格納する際のインデクス番号に使用) ※【2】※

Dim iTotalStudents   As Long    '全学生数※【1】※
Dim iLastStudentRow  As Long    '学生列の終端行番号
Dim iLastSubject     As Long    '最後の科目の列番号
Dim arrTestScore     As Variant '学生ごとの各科目の点数を格納する配列変数
Dim arrTotalScore    As Variant '全学生の合計点のみを格納する配列変数
Dim sumTotalScore    As Long    '個々の学生の点数を1科目ずつ加算し格納
Dim x                As Long    '配列 arrTestScore内を走査するための列方向のインデックス番号
Dim y                As Long    '配列 arrTestScore内を走査するための行方向のインデックス番号

'WorkSheets("Sheet1")以外からの実行に対応させるために計算のためのワークシートを変数へ格納
Dim wsKeisan  As Worksheet
Set wsKeisan = Worksheets("Sheet1")
  
'行番号
Const iRowsStartPosY     As Long = 1    '一覧の先頭行番号
Const iStudentStartPosY  As Long = 2    '学生の先頭行番号

'列番号
Const iStudentNoPosX     As Long = 1    '学生番号列
Const iStudentNamePosX   As Long = 2    '学生氏名列
Const iSubjectsStartPosX As Long = 3    '科目名開始列

    '初期化
    iRowsCnt = 0
    iColCnt = 0
    iTotalStudents = 0
    
    '★ Do While (1)  って何?? _
         Do While(1) は無限ループを使用した繰り返し処理の方法 _
         Do While(1)の直下に終了条件を書かないと無限ループに陥りますのでご注意を。 _
         下の例だと、1行目の項目名を走査し、合計点のセルを指したら処理を終了し、ループを抜けます。
    
    ' // 科目数をカウント。 _
         ループ処理は1行目を走査し、全合計セルを指したら終了
    Do While (1)
        If Worksheets("Sheet1").Cells(iRowsStartPosY, iSubjectsStartPosX + iColCnt).Value = "合計点" Then
            iColCnt = 0
            Exit Do
        End If
    
        If Worksheets("Sheet1").Cells(iRowsStartPosY, iSubjectsStartPosX + iColCnt).Value <> "" Then
            iSubjectsCnt = iSubjectsCnt + 1
        End If
    
        ' // 列カウンタをインクリメント
        iColCnt = iColCnt + 1
    Loop

Stop  '動作チェック用のStopステートメント。ここで一時停止します。不要でしたら削除してください。

2.前回集計時の合計点が存在したら自動削除

    ' // 前回集計時の合計点が存在したら自動削除
    '1列目の学生番号列を走査し、空白セルを指したら終了。
    Do While (1)
        If Worksheets("Sheet1").Cells(iRowsStartPosY + iRowsCnt, iStudentNoPosX).Value = "" Then
            iRowsCnt = 0
            Exit Do
        End If
    
        ' // 合計点セル(学生氏名列番号 + 科目数 + 1 は合計点列の列番号)が空白セルではない場合は値を削除(空文字を代入)
        If Worksheets("Sheet1").Cells(iStudentStartPosY + iRowsCnt, iStudentNamePosX + iSubjectsCnt + 1).Value <> "" Then
            Worksheets("Sheet1").Cells(iStudentStartPosY + iRowsCnt, iStudentNamePosX + iSubjectsCnt + 1).Value = ""
        End If
    
        ' // 列カウンタをインクリメントし次の科目へ移動
        iRowsCnt = iRowsCnt + 1
        
    Loop

Stop  '動作チェック用のStopステートメント。不要でしたら削除してください。

3.学生数をカウント

    ' // 学生数をカウントし配列のインデックスに使用 ※【1】※
    Do While (1)
        If Worksheets("Sheet1").Cells(iRowsStartPosY + iRowsCnt, iStudentNoPosX).Value = "" Then
            iRowsCnt = 0
            Exit Do
        End If
    
        ' // 学生番号列を走査し、学生番号が空白セルではない場合にカウンタを加算して人数をカウント
        If Worksheets("Sheet1").Cells(iStudentStartPosY + iRowsCnt, iStudentNoPosX).Value <> "" Then
        
            ' // 学生数カウンタを加算
            iTotalStudents = iTotalStudents + 1
            
        End If
    
        '行カウンタをインクリメント
        iRowsCnt = iRowsCnt + 1
    Loop
    
    iColCnt = 0
    
Stop  '動作チェック用のStopステートメント。不要でしたら削除してください。

4.個人のテストの点数を配列に格納後、配列内をループ処理し、合計点算出、合計点のみを別の配列に格納

    ' // 最後の学生の行番号を取得(学生数+1(項目行))
    iLastStudentRow = iTotalStudents + 1
       
    ' // 今回の投稿の醍醐味!テストの点数のみを配列へ一括格納 _
         セル範囲の指定は Range(処理対象のワークシートを格納した変数.Cells(行番号,列番号),処理対象のワークシートを格納した変数.Cells(行番号,列番号)) という形式で指定します。 _
          初回投稿時にはココの 「処理対象のワークシートを格納した変数.」 が抜けていたため、他のワークシートからの実行ができないとご指摘をうけ、修正致しました。

    arrTestScore = wsKeisan.Range(wsKeisan.Cells(iStudentStartPosY, iSubjectsStartPosX), wsKeisan.Cells(iLastStudentRow, iStudentNamePosX + iSubjectsCnt)).Value
    
    ' // 合計点をまとめて格納する配列の要素数を学生数 で再定義 ※【1】※
    ReDim arrTotalScore(1 To iTotalStudents)
    
    ' // 初期化処理
    sumTotalScore = 0
  
    ' // 学生数カウンタを1で初期化
    iStudentCnt = 1 
  
    For y = LBound(arrTestScore, 1) To UBound(arrTestScore, 1)      ' 学生(=行方向)
        For x = LBound(arrTestScore, 2) To UBound(arrTestScore, 2)  ' 科目(=列方向)
            Debug.Print arrTestScore(y, x)
      
            ' // 1科目ずつ点数を加算処理
            sumTotalScore = sumTotalScore + arrTestScore(y, x)
            Debug.Print "sumTotalScore" & sumTotalScore
            
        Next x  

        ' // 今回欲しいのは合計点のみ。合計点のみを別の配列(arrTotalScore)へ一人ずつ順に格納。要素数は学生数(iStudentCnt) ※【2】※
        arrTotalScore(iStudentCnt) = sumTotalScore
    
        ' // 学生数カウンタをインクリメントし次の学生に移動。
        iStudentCnt = iStudentCnt + 1
    
        ' // 合計点を初期化
        sumTotalScore = 0
    Next y
  

個人のテスト結果が配列に格納されていますね!  arrTestScore

f:id:Tompsom:20200202104236p:plain

合計点数のみを格納した配列  arrTotalScore

f:id:Tompsom:20200202104559p:plain

5.全合計をセルへまとめて出力

    ' // 全合計をセルへまとめて出力
    ' //  一次元配列は横方向にしか一括代入できないので、縦方向にするためにワークシート関数の「Transpose関数」を用いる
    ' //  Transpose関数はワークシートでよく使う「形式を指定して貼り付け」の「行列の入れ替え」のこと。
    wsKeisan.Range(wsKeisan.Cells(2, 8), wsKeisan.Cells(11, 8)).Value = WorksheetFunction.Transpose(arrTotalScore)

Stop  '動作チェック用のStopステートメント。不要でしたら削除してください。

' // 配列を初期化
Erase arrTestScore
Erase arrTotalScore

' // ワークシートオブジェクトの参照を解除
Set = wsKeisan=Nothing

End Sub