転記！マクロ？ワークシート関数です

転記となるとマクロ？。危なっかしいというかSubプロシージャを書くのにパワーがいる。何が難しいのかというとセルの位置の指定ですよね。一方、ワークシート関数は、セルに埋め込むので目的のセルにデータを入れる。確実に指定のセルに入れる？表示することができる。

エクセルのワークシート関数を使うならINDEX関数？なんかな。

ここではユーザー定義関数/カスタム関数/自作関数であるmyIndex関数を作ります。INDEX関数とは関係ありません。

例題、テスト結果の表と受講台帳がある。この２つの表から合格者の表を作る。表の項目は、クラス番号、出席番号、名前、各科目の点数とする。

これがすぐできる人は天才です。私は、「困難は分割せよ」、「数が多い時は少なくして、データの桁が大きい時は小さくして考える」ということを心がけます。「困難は分割せよ」の方は有名かな？。２つ目は経験から。プログラムではこの考えで複数の関数を作る。

ここでは、合格者の配列を返す関数myGoukakuを作る。これは、myTemplateを参考にしてます。

'とにかく合の人だけを返す
Function myGoukaku(rTest As Range)
    Dim ar() 'Rangeの範囲のデータを入れる動的配列
    ar = rTest 'セルの値が入る
    Dim i As Integer, j As Integer
    j = 1 'For文の中で使い始めで0だと飛ぶため。
    ReDim arr(1 To UBound(ar, 1), 1 To UBound(ar, 2)) 'データ以上になることは無い
    Dim ii As Integer 'arrの行番号用、列はjを使う
    For i = 1 To UBound(ar, 1) '２次元配列の１番目、行。１から始めるのはｒがRangeだから
            If "合" = ar(i, 6) Then '６列目に合か否かがある
                ii = ii + 1 'スタートが１なので先に１にしておく
                For j = 1 To UBound(ar, 2) '２次元配列の２番目、列
                        arr(ii, j) = ar(i, j)
                Next
            End If
   Next
    myGoukaku = arr
End Function

その２では、合格者名と一致する受講台帳の行の配列を返す関数です。

Sub　テスト表（）プロシージャを実行する前に、以下の関数を先に標準モジュールに貼り付けます。

Function hanntei(setu, tori, hou)
    If setu + tori + hou ＜180 Then
        hanntei = "不"
    Else
        hanntei = "合" '以下の判定前にとりあえず合
        If setu ＜ 40 Then hanntei = "不" 'Thenの内容が簡素なら一行の方が見やすい
        If tori ＜40 Then hanntei = "不"
        If hou ＜ 40 Then hanntei = "不"
    End If
End Function

テスト表作成のマクロ。上の関数を使うので先に上の関数を貼り付けて下さい。以下のマクロも標準モジュールに貼り付け実行します。

Sub テスト表()
   If VBA.MsgBox("選択しているワークシートに上書きします！！！", vbOKCancel) = VBA.vbCancel Then Exit Sub
    If ActiveSheet.ListObjects.Count = 1 Then ActiveSheet.ListObjects(1).Delete

    Range("A1") = "名前"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ナマエ"
    Range("B1") = "設備"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "セツビ"
    Range("C1") = "取扱"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "トリアツカイ"
    Range("D1") = "法規"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ホウレイ"
    Range("E1") = "判定"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ハンテイ"

    Range("A2") = "名前１"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ナマエ"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A８"), Type:=xlFillDefault
    Range("A2:A10").Select
    
    Range("B2") = "56"
    Range("C2") = "87"
    Range("D2") = "87"
    Range("B3") = "76"
    Range("C3") = "76"
    Range("D3") = "89"
    Range("B4") = "54"
    Range("C4") = "67"
    Range("D4") = "34"
    Range("B4") = "90"
    Range("B5") = "89"
    Range("C5") = "78"
    Range("D5") = "67"
    Range("B6") = "56"
    Range("C6") = "45"
    Range("D6") = "67"
    Range("B7") = "48"
    Range("C7") = "68"
    Range("D7") = "43"
    Range("B8") = "23"
    Range("C8") = "67"
    Range("D8") = "87"
    Range("C8") = "98"
    
        

    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1") = "No"
    Range("A2") = "1"
    Range("A2").Select
    Selection.AutoFill Destination:=Range("A2:A8"), Type:=xlFillSeries
    Range("A2:A8").Select
    Range("D5").Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$F$8"), , xlYes).Name = _
        "テーブル3"
    
    Range("F2") = "=hanntei([@設備],[@取扱],[@法規])"

End Sub

受講生台帳の作成

Sub 受講生台帳()
   If VBA.MsgBox("選択しているワークシートに上書きします！！！", vbOKCancel) = VBA.vbCancel Then Exit Sub
    If ActiveSheet.ListObjects.Count = 1 Then ActiveSheet.ListObjects(1).Delete
    
    Range("A1") = "No"
    Range("A2") = "1"
    Range("A2").AutoFill Destination:=Range("A2:A8"), Type:=xlFillSeries

    Range("B1") = "クラス"
    Range("B2") = "1"
    Range("B3") = "2"
    Range("B4") = "1"
    Range("B5") = "1"
    Range("B6") = "2"
    Range("B7") = "1"
    Range("B8") = "2"
    Range("C1") = "出席番号"
    ActiveCell.Characters(1, 4).PhoneticCharacters = "シュ"
    Range("C2") = "1"
    Range("C3") = "1"
    Range("C4") = "3"
    Range("C5") = "2"
    Range("C6") = "2"
    Range("C7") = "4"
    Range("C8") = "3"
    
    Range("d1") = "名前"
    Range("d2") = "名前１"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ナマエ"
    Range("d2").Select
    Selection.AutoFill Destination:=Range("d2:d８"), Type:=xlFillDefault
    
    Range("E1") = "住所"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ジュウショ"
    Range("E2") = "住所１"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ジュウショ"
    Range("E2").Select
    Selection.AutoFill Destination:=Range("E2:E8")
    Range("E2:E8").Select
    Range("D3").Select
    Application.CutCopyMode = False
    ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$E$8"), , xlYes).Name = _
        "テーブル12"
    Range("テーブル12[#All]").Select
End Sub