まりふのひと

項目を横に持ったテーブルを縦にするモジュール例

Access

３時、ふと目が覚め、方法を考えていたら眠れなくなったので起きてコーディングした。
縦を横にするのは、クロス集計クエリーで出来るが、逆はモジュールで対応するしかない？


↓↓↓

VBA

  1. Field オブジェクトを参照する場合、次のいずれの構文も使用できる。
    • Fields(0)
    • Fields("name")
    • Fields![name]
  2. インデックスの開始値は 0
  3. Field 数は、Count プロパティで取得できる。
Option Compare Database
Option Explicit
Const OBJName As String = "M_make成績一覧表"

Public Function make成績一覧表() As Boolean
On Error GoTo Err_make成績一覧表
Dim mbTitle As String
Const xlsTable As String = "xls期末考査"
Const OutTable As String = "W_成績一覧表"
Const lng科目開始 As Long = 5
Dim CNN As New ADODB.Connection
Dim RS1 As New ADODB.Recordset, RS2 As New ADODB.Recordset
Dim i As Long, lngField As Long, lng科目数 As Long

    mbTitle = OBJName & "/make成績一覧表"
    lng科目数 = DLookup("科目数", xlsTable)
        '出力ﾃｰﾌﾞﾙのｸﾘｱ
    DoCmd.SetWarnings False
    DoCmd.RunSQL "Delete * from " & OutTable
    DoCmd.SetWarnings True
        'I/Oﾃｰﾌﾞﾙを開く
    CNN.Open CurrentProject.Connection
    RS1.Open xlsTable, CNN, adOpenForwardOnly, adLockReadOnly
    RS2.Open OutTable, CNN, adOpenKeyset, adLockOptimistic
    With RS2
        Do Until RS1.EOF
            For i = 1 To lng科目数
                .AddNew
                !組 = RS1!年組
                !番 = RS1!番
                !氏名 = RS1!氏名
                lngField = (i - 1) + (lng科目開始 - 1)      '5番目の項目のｲﾝﾃﾞｯｸｽは4
                !科目名 = RS1.Fields(lngField).Name
                !得点 = RS1.Fields(lngField).Value
'                Debug.Print i, lngField, !科目名, !得点
                !全順位 = RS1!全順
                !学級順位 = RS1!級順
                .Update
            Next
            RS1.MoveNext
        Loop
        RS1.Close
        .Close
    End With
    make成績一覧表 = True

Exit_make成績一覧表:
    CNN.Close
    Exit Function

Err_make成績一覧表:
    MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
    Resume Exit_make成績一覧表
End Function
  1. 科目数は入力テーブル中にあるものとしている。
    • lng科目数 = DLookup("科目数", xlsTable)