横に並ぶ項目を縦に並べる関数 JK_YOKO_TATE

人間様は、横に並んだ項目がわかりやすいのでしょうが、機械さまは、縦長の方が都合が良い場合が多いです。例えば、給与結果データを管理する場合、人間は、縦軸に社員番号、横軸に、支給年月日、基本給、住宅手当、通勤手当・・・と並べますが、データベースで管理する場合には、横に長く並べるより、社員番号、支給年月日、支給項目、値　とした方が、ずっと管理しやすく、その後の演算も容易です。縦長のデータを横長にするには、クロスクエリが使用できますが、逆はありません。この関数は、人間様用に作られている横長のデータを縦長に直す関数です。 
Function JK_YOKO_TATE(TAISYOU_TAB As String, SAKI_TAB As String, KEY_1 As String, Optional KEY_2 As _
String, Optional KEY_3 As String, Optional KEY_4 As String, Optional KEY_5 As String, Optional KEY_6 _
As String, Optional KEY_7 As String, Optional KEY_8 As String)
'横長のデータを縦長に直すモジュール。各々項目名を受け取るフィールド名は COL 値を受け取るフィールド名は
'VALUE という名前で受け取る はじめにテーブルを作成する。キーは１〜８項目設定でき、縦に並べ替える対象
'項目からはずし、全レコードに表示される。例：社員ID＋支給年月日などをキーにする
Dim tCol As String
Dim sqlStr As String

sqlStr = "SELECT '@@@' AS " & KEY_1 & ""
If Len(KEY_2) > 0 Then
   sqlStr = sqlStr & ",'@@@' AS " & KEY_2
End If
If Len(KEY_3) > 0 Then
   sqlStr = sqlStr & ",'@@@' AS " & KEY_3
End If
If Len(KEY_4) > 0 Then
   sqlStr = sqlStr & ",'@@@' AS " & KEY_4
End If
If Len(KEY_5) > 0 Then
   sqlStr = sqlStr & ",'@@@' AS " & KEY_5
End If
If Len(KEY_6) > 0 Then
   sqlStr = sqlStr & ",'@@@' AS " & KEY_6
End If
If Len(KEY_7) > 0 Then
   sqlStr = sqlStr & ",'@@@' AS " & KEY_7
End If
If Len(KEY_8) > 0 Then
   sqlStr = sqlStr & ",'@@@' AS " & KEY_8
End If

sqlStr = sqlStr & ",'@@@' AS COL,'@@@' AS [VALUE] INTO " & SAKI_TAB
DoCmd.RunSQL sqlStr

sqlStr = "DELETE * FROM " & SAKI_TAB
DoCmd.RunSQL sqlStr

whstr = "TB_NM='" & TAISYOU_TAB & "'"
MaxD = DCount("COL_NM", "T_0051_TBCOL", whstr)
sID = DLookup("COL_ID", "T_0051_TBCOL", whstr)

For i = 1 To MaxD
   '項目を順番に取得
   whstr2 = whstr & " AND COL_ID=" & sID + i - 1
   tCol = DLookup("COL_NM", "T_0051_TBCOL", whstr2)

   If tCol <> KEY_1 And tCol <> KEY_2 And tCol <> KEY_3 And tCol <> KEY_4 And tCol <> KEY_5 And tCol <> _
   KEY_6 And tCol <> KEY_7 And tCol <> KEY_8 Then
       sqlStr = "INSERT INTO " & SAKI_TAB & " (" & KEY_1
       If Len(KEY_2) > 0 Then
           sqlStr = sqlStr & "," & KEY_2
       End If
       If Len(KEY_3) > 0 Then
           sqlStr = sqlStr & "," & KEY_3
       End If
       If Len(KEY_4) > 0 Then
           sqlStr = sqlStr & "," & KEY_4
       End If
       If Len(KEY_5) > 0 Then
           sqlStr = sqlStr & "," & KEY_5
       End If
       If Len(KEY_6) > 0 Then
           sqlStr = sqlStr & "," & KEY_6
       End If
       If Len(KEY_7) > 0 Then
           sqlStr = sqlStr & "," & KEY_7
       End If
       If Len(KEY_8) > 0 Then
           sqlStr = sqlStr & "," & KEY_8
       End If
       sqlStr = sqlStr & ",[COL],[VALUE]) SELECT nz([" & TAISYOU_TAB & "].[" & KEY_1 & "],'NULL')"
       If Len(KEY_2) > 0 Then
           sqlStr = sqlStr & ",nz([" & TAISYOU_TAB & "].[" & KEY_2 & "],'NULL')"
       End If
       If Len(KEY_3) > 0 Then
           sqlStr = sqlStr & ",nz([" & TAISYOU_TAB & "].[" & KEY_3 & "],'NULL')"
       End If
       If Len(KEY_4) > 0 Then
           sqlStr = sqlStr & ",nz([" & TAISYOU_TAB & "].[" & KEY_4 & "],'NULL')"
       End If
       If Len(KEY_5) > 0 Then
           sqlStr = sqlStr & ",nz([" & TAISYOU_TAB & "].[" & KEY_5 & "],'NULL')"
       End If
       If Len(KEY_6) > 0 Then
           sqlStr = sqlStr & ",nz([" & TAISYOU_TAB & "].[" & KEY_6 & "],'NULL')"
       End If
       If Len(KEY_7) > 0 Then
           sqlStr = sqlStr & ",nz([" & TAISYOU_TAB & "].[" & KEY_7 & "],'NULL')"
       End If
       If Len(KEY_8) > 0 Then
           sqlStr = sqlStr & ",nz([" & TAISYOU_TAB & "].[" & KEY_8 & "],'NULL')"
       End If
       sqlStr = sqlStr & ",'" & tCol & "' AS col1,nz([" & TAISYOU_TAB & "].[" & tCol & "],'NULL') _
       as col2"
       sqlStr = sqlStr & " FROM " & TAISYOU_TAB & ";"
       'MsgBox sqlStr
       DoCmd.RunSQL sqlStr
   End If

Next i

End Function