人間様は、横に並んだ項目がわかりやすいのでしょうが、機械さまは、縦長の方が都合が良い場合が多いです。例えば、給与結果データを管理する場合、人間は、縦軸に社員番号、横軸に、支給年月日、基本給、住宅手当、通勤手当・・・と並べますが、データベースで管理する場合には、横に長く並べるより、社員番号、支給年月日、支給項目、値 とした方が、ずっと管理しやすく、その後の演算も容易です。縦長のデータを横長にするには、クロスクエリが使用できますが、逆はありません。この関数は、人間様用に作られている横長のデータを縦長に直す関数です。
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 という名前で受け取る はじめにテーブルを作成する。キーは1〜8項目設定でき、縦に並べ替える対象
'項目からはずし、全レコードに表示される。例:社員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