Accessで縦と横を入れ替えたい

質問

りんご みかん ぶどう バナナ いちご
佐藤 2 　 1 　　 1 　 1 　1
鈴木 1 　　　　 1 　 1
田中 1 　 2 　　　　　 1

上記のようなテーブルがあるのですが、これを下記のようにしたいです。

担当者 種別
田中 りんご
鈴木 りんご
佐藤 りんご
田中 みかん
佐藤 みかん
佐藤 ぶどう
鈴木 バナナ
佐藤 バナナ
田中 いちご
鈴木 いちご
佐藤 いちご
佐藤 りんご
田中 みかん

種別の隣に数量がきてもOKです。
ご教授お願い致します。

回答No.6

山田 太郎（@f_a_007）

【補足】追加クエリの書き方！

INSERT INTO テーブル3
SELECT *
FROM クエリ33;

先のユニオンクエリを"クエリ33"だとします。その場合、これで添付図のようにテーブルに行が追加されます。

回答No.5

piroin654

わざわざデータの並びが特徴的に表記してあるので、
取得するデータの方向と並びを質問の例から推論すると、

1　出発は最初のフィールドの一番最後のレコードを取得
2　同じフィールドを最初のレコードに向かってレコードを取得
3　次のフィールドに移動し、一番最後のレコードを取得し、2を行なう
4　一度、全レコードの全フィールドを取り出したら、再び1に戻り
　フィールドの値が+1のものを検索してレコードを取得
5　以降繰り返し

のようなことですかね。テーブルのデータの並びが
よく分からないので、並び替えのデータからすると、
以下のようなことでいいですか。

　　　りんご　　みかん　　ぶどう　　バナナ　　いちご
佐藤　2　　　　　1　　　　　　1　　　　　1　　　　　1
鈴木　1　　　　　　　　　　　　　　　　　1　　　　　1
田中　1　　　　　2　　　　　　　　　　　　　　　　　　1

そこで、上記のテーブルのフィールド名を付け加えて、

名前　りんご　みかん　　ぶどう　　バナナ　　いちご
佐藤　　2　　　　　1　　　　　　1　　　　　1　　　　　1
鈴木　　1　　　　　　　　　　　　　　　　　1　　　　　1
田中　　1　　　　　 2　　　　　　　　　　　　　　　　　1

のように、します。このテーブルの名前を「テーブルA」とします。
要するにテーブルのデザインでいえば、

　名前　　　　　テキスト型
　りんご　　　　数値型
　みかん　　　　数値型
　ぶどう　　　　数値型
　バナナ　　　　数値型
　いちご　　　　数値型

次に並び替えたデータを受け取るテーブルを「テーブルB」とします。
フィールドは、

ID　　　　　オートナンバー
担当者　　　テキスト型
種別　　　　テキスト型
数量　　　　数値型

とします。IDは主キーにはしません。並びを確保する
ために使用します。

以下のコードを標準モジュールに貼り付け、保存し
実行してみてください。
なお、DAOを使っているので、コード表のツールから
参照設定を選択し、
　　Microsoft DAO xx Object Library
にチェックが入っているか確認してください。

Sub test()
　　Dim db As DAO.Database
　　Dim rs1 As DAO.Recordset
　　Dim rs2 As DAO.Recordset
　　Dim i As Long
　　Dim iMax As Long
　　Dim j As Long
　　Dim k As Long

　　Set db = CurrentDb
　　Set rs1 = db.OpenRecordset("テーブルA")
　　Set rs2 = db.OpenRecordset("テーブルB", dbOpenDynaset)

　　iMax = 1
　　rs1.MoveFirst
　　Do Until rs1.EOF
　　　　For i = 1 To rs1.Fields.Count - 1
　　　　　　If Not IsNull(rs1.Fields(i)) Then
　　　　　　　　If rs1.Fields(i).Value > iMax Then
　　　　　　　　　　iMax = rs1.Fields(i).Value
　　　　　　　　End If
　　　　　　End If
　　　　Next i
　　　　rs1.MoveNext
　　Loop

　　For j = 1 To iMax
　　　　For k = 1 To rs1.Fields.Count - 1
　　　　　　rs1.MoveLast
　　　　　　Do Until rs1.BOF
　　　　　　　　If Not IsNull(rs1.Fields(k)) Then
　　　　　　　　　　If rs1.Fields(k).Value >= j Then
　　　　　　　　　　　　rs2.AddNew
　　　　　　　　　　　　rs2!担当者 = rs1!名前
　　　　　　　　　　　　rs2!種別 = rs1.Fields(k).Name
　　　　　　　　　　　　rs2!数量 = rs1.Fields(k).Value
　　　　　　　　　　　　rs2.Update
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　rs1.MovePrevious
　　　　　　Loop
　　　　Next k
　　Next j

　　rs1.Close: Set rs1 = Nothing
　　rs2.Close: Set rs2 = Nothing
　　db.Close: Set db = Nothing
End Sub

なお、「テーブルA」レコードの順序は確保されているものとします。

単純に「横のものを縦に」ということであれば、こんなまわりくどいことを
する必要はありませんが。

回答No.4

山田 太郎（@f_a_007）

【お詫び】バグがありました！

× SELECT 担当者, DBLookup("SELECT 'りんご' AS 種別 FROM Test3 WHERE Nz([りんご])>0") As 種別, りんご As 数量 FROM Test3

〇 SELECT 担当者, DBLookup("SELECT 'りんご' AS 種別 FROM Test3") As 種別, りんご As 数量 FROM Test3 WHERE Nz([りんご])>0

テストはしてませんが、WHERE 節の位置が間違っていました。ですから、0でもレコードが発生しています。0でも発生して良いのであれば

〇 SELECT 担当者, DBLookup("SELECT 'りんご' AS 種別 FROM Test3") As 種別, りんご As 数量 FROM Test3

でOKかと思います。（多分）

回答No.3

山田 太郎（@f_a_007）

【補足の補足】As 数量

SELECT 担当者, DBLookup("SELECT 'りんご' AS 種別 FROM Test3 WHERE Nz([りんご])>0") As 種別, りんご As 数量 FROM Test3

回答No.2

山田 太郎（@f_a_007）

【補足】UNIONクエリの補足

SELECT 担当者, DBLookup("SELECT 'りんご' AS 種別 FROM Test3 WHERE Nz([りんご])>0") As 種別, りんご FROM Test3

１、 As 種別・・・欠落していました。
２、ORDER BY 節・・・指定していません。

回答No.1

山田 太郎（@f_a_007）

【VBA】

VBAで変換・登録するのが一番確実で実際的かと思います。次は、その第一ステップのテスト結果です。

＞ID:1;担当者:佐藤;りんご:2;みかん:1;ぶどう:1;バナナ:1;いちご:1;

DXSelect()の戻り値を手がかりに

DoCmd.RunSQL SQL文

で、新しいテーブルに行を挿入すれば目的は達成できます。

【UNIONクエリ】

もちろん、簡便にUNIONクエリを利用する手もなきにしもあらずです。

SELECT
　　担当者,
　　DBLookup("SELECT 'りんご' AS 種別 FROM Test3 WHERE Nz([りんご])>0"),
　　りんご
　　FROM Test3
UNION
SELECT
　　担当者,
　　DBLookup("SELECT 'みかん' AS 種別 FROM Test3 WHERE Nz([みかん])>0"),
　　みかん
　　FROM Test3
UNION
SELECT
　　担当者,
　　DBLookup("SELECT 'ぶどう' AS 種別 FROM Test3 WHERE Nz([ぶどう])>0"),
　　ぶどう
　　FROM Test3
UNION
SELECT
　　担当者,
　　DBLookup("SELECT 'バナナ' AS 種別 FROM Test3 WHERE Nz([バナナ])>0"),
　　バナナ
　　FROM Test3
UNION
SELECT
　　担当者,
　　DBLookup("SELECT 'いちご' AS 種別 FROM Test3 WHERE Nz([いちご])>0"),
　　いちご　
　　FROM Test3;

こういうUNIONクエリの結果を INSERT　するという手もあります。

※DBLookup()

DBLookup()は、UNIONクエリを安直に書くためのユーザー関数です。

Public Function DBLookup(ByVal strQuerySQL As String, _
　　　　　　　　　　　　　Optional ByVal ReturnValue = Null) As Variant
On Error GoTo Err_DBLookup
　　Dim DataValue
　　Dim rst　　　　 As ADODB.Recordset

　　Set rst = New ADODB.Recordset
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　.MoveFirst
　　　　　　DataValue = .Fields(0)
　　　　End If
　　End With
Exit_DBLookup:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBLookup = IIf(Len(DataValue & ""), DataValue, ReturnValue)
　　Exit Function
Err_DBLookup:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _
　　　　　 "・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　 "・SQL Text=" & strQuerySQL, _
　　　　　 vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBLookup
End Function