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

質問

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

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

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

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

回答No.16

山田 太郎（@f_a_007）

× DoCmd.RunSQL Replace(strRecord(I), XXXXX, strRecord(I))
〇 DoCmd.RunSQL Replace(strSQL, ”XXXXX”, strRecord(I))

回答No.15

山田 太郎（@f_a_007）

【続】DXSelect()

DXSelect()の戻り値は添付図のようです。この戻り値をSplit関数で配列 strRecord()に格納。その後、For-Next でテーブルに挿入。

strSQL = "INSERT INTO テーブル3 (ID, 担当者, 種別, 数量) VALUES (XXXXX)"
N=UBound(strRecord)
For I = 0 To N
　　DoCmd.RunSQL Replace(strRecord(I), XXXXX, strRecord(I))
Next I

DBSelect関数では敢えて数量0を除外していません。もし、仮にそういう希望であれば、最後に

DoCmd.RunSQL "DELETE FROM ・・・・"

の１行を。

Public Function DXSelect(ByVal strQuerySQL As String, _
　　　　　　　　　　　　 Optional strPause As String = ";") As String
On Error GoTo Err_DXSelect
　　Dim isTopField　As Boolean
　　Dim I　　　　　 As Integer
　　Dim J　　　　　 As Integer
　　Dim N　　　　　 As Integer
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strTanto　　As String
　　Dim strList　　 As String
　　Dim strNewList　As String

　　Set rst = New ADODB.Recordset
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　J = 0
　　　　　　N = .RecordCount - 1
　　　　　　.MoveFirst
　　　　　　For I = 0 To N
　　　　　　　　isTopField = True
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　If isTopField Then
　　　　　　　　　　　　strTanto = "'" & fld.Value & "'"
　　　　　　　　　　　　isTopField = False
　　　　　　　　　　Else
　　　　　　　　　　　　strList = strList & J & "," & _
　　　　　　　　　　　　　　　　　strTanto & "," & _
　　　　　　　　　　　　　　　　　"'" & fld.Name & "'" & "," & _
　　　　　　　　　　　　　　　　　fld.Value & Chr(13)
　　　　　　　　　　End If
　　　　　　　　　　J = J + 1
　　　　　　　　Next fld
　　　　　　　　.MoveNext
　　　　　　Next I
　　　　Else
　　　　　　strList = ""
　　　　End If
　　End With
Exit_DXSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DXSelect = IIf(Len(strList) > 0, Replace(strList & "[END]", Chr(13) & "[END]", ""), "")
　　Exit Function
Err_DXSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DXSelect)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DXSelect
End Function

回答No.14

piroin654

＞数量がゼロのところを表示しないようにはできないでしょうか？

(1)
それでは、Nullの場合も0の場合もはじく、ということならば、

　　Dim db As DAO.Database
　　Dim rs1 As DAO.Recordset
　　Dim rs2 As DAO.Recordset
　　Dim j As Long
　　Dim k As Long

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

　　　　For k = 1 To rs1.Fields.Count - 1
　　　　　　rs1.MoveFirst
　　　　　　Do Until rs1.EOF
　　　　　　　　If Not IsNull(rs1.Fields(k)) Then
　　　　　　　　　　If Not rs1.Fields(k).Value = 0 Then
　　　　　　　　　　　　rs2.AddNew
　　　　　　　　　　　　rs2!担当者 = rs1!名前
　　　　　　　　　　　　rs2!種別 = rs1.Fields(k).Name
　　　　　　　　　　　　rs2!数量 = rs1.Fields(k).Value
　　　　　　　　　　　　rs2.Update
　　　　　　　　　　End If
　　　　　　　　End If
　　　　　　　　rs1.MoveNext
　　　　　　Loop
　　　　Next k

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

(2)
テーブルのデータにはNullがないので、0の場合を
はじく、というのであれば、

　　Dim db As DAO.Database
　　Dim rs1 As DAO.Recordset
　　Dim rs2 As DAO.Recordset
　　Dim j As Long
　　Dim k As Long

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

　　　　For k = 1 To rs1.Fields.Count - 1
　　　　　　rs1.MoveFirst
　　　　　　Do Until rs1.EOF
　　　　　　　　　　If Not rs1.Fields(k).Value = 0 Then
　　　　　　　　　　　　rs2.AddNew
　　　　　　　　　　　　rs2!担当者 = rs1!名前
　　　　　　　　　　　　rs2!種別 = rs1.Fields(k).Name
　　　　　　　　　　　　rs2!数量 = rs1.Fields(k).Value
　　　　　　　　　　　　rs2.Update
　　　　　　　　　　End If
　　　　　　　　rs1.MoveNext
　　　　　　Loop
　　　　Next k

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

要するに、

　　　　　　　　If Not IsNull(rs1.Fields(k)) Then
　　　　　　　　　　If Not rs1.Fields(k).Value = 0 Then

の条件式を両方入れるか一方にするかの違いです。

お礼

できました。
いろいろとお世話になりました。ありがとうございました。

回答No.13

piroin654

>のようにできればOKなので、(1)のほうでしょうか。

はい。(1)です。できましたか？

お礼

コードの実行はできましたが、数量がゼロのところを表示しないようにはできないでしょうか？

回答No.12

piroin654

失礼しました。訂正です。
No11の(2)の終わりに、

Nullのデータの処理については(1)と同じです。

としていますが、処理には多少コードを
変更しなければならないので、必要ならば
提示しますが。

お礼

何度も申し訳ありません。
元々のデータが

佐藤…りんご2、みかん1、ぶどう1、バナナ1、いちご1
鈴木…りんご1、バナナ1、いちご1
田中…りんご1、みかん2、いちご1　
となっているテーブルを

ID　　担当者　　種別　　数量
1　　　佐藤　　　りんご　2
2　　　鈴木　　　りんご　1
3　　　田中　　　りんご　1
4　　　佐藤　　　みかん　1
5　　　田中　　　みかん　2
6　　　佐藤　　　ぶどう　1
7　　　佐藤　　　バナナ　1
8　　　鈴木　　　バナナ　1
9　　　佐藤　　　いちご　1
10　　　鈴木　　いちご　　1
11　　　田中　　いちご　　1

のようにできればOKなので、(1)のほうでしょうか。

回答No.11

piroin654

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

といった感じにできれば。

の、....　以下がどのようになっているのかが
問題なのですが・・・・。
質問のデータでは「鈴木」には「ぶどう」は無かったような・・・。

（１）
ともあれ、以下では

　　Dim db As DAO.Database
　　Dim rs1 As DAO.Recordset
　　Dim rs2 As DAO.Recordset
　　Dim j As Long
　　Dim k As Long

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

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

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

データは、

ID　　担当者　　種別　　数量
1　　　佐藤　　　りんご　2
2　　　鈴木　　　りんご　1
3　　　田中　　　りんご　1
4　　　佐藤　　　みかん　1
5　　　田中　　　みかん　2
6　　　佐藤　　　ぶどう　1
7　　　佐藤　　　バナナ　1
8　　　鈴木　　　バナナ　1
9　　　佐藤　　　いちご　1
10　　　鈴木　　いちご　　1
11　　　田中　　いちご　　1

のように、単純に「テーブルA」の先頭レコードから
データを取り出し、「テーブルB」に格納します。
なお、「テーブルA」でデータがNullのものも表示するならば、
　　　rs2!数量 = rs1.Fields(k).Value
を、
　　　rs2!数量 = Nz(rs1.Fields(k).Value)
Nullを0とするならば、
　　　rs2!数量 = Nz(rs1.Fields(k).Value, 0)
とします。

（２）
以下では、

　　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.MoveFirst
　　　　　　Do Until rs1.EOF
　　　　　　　　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.MoveNext
　　　　　　Loop
　　　　Next k
　　Next j

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

取り出したデータは、

ID　　担当者　　種別　　数量
1　　　佐藤　　　りんご　2
2　　　鈴木　　　りんご　1
3　　　田中　　　りんご　1
4　　　佐藤　　　みかん　1
5　　　田中　　　みかん　2
6　　　佐藤　　　ぶどう　1
7　　　佐藤　　　バナナ　1
8　　　鈴木　　　バナナ　1
9　　　佐藤　　　いちご　1
10　　　鈴木　　いちご　1
11　　　田中　　いちご　1
12　　　佐藤　　りんご　2
13　　　田中　　みかん　2

のように、「テーブルB」に格納されます。
Nullのデータの処理については(1)と同じです。

(1)と(2)のどちらのデータの並びが必要なのかを
もう少し・・・。

以上です。たぶん動くと思いますが。

回答No.10

piroin654

Ｎｏ9の追加ですが、

もし、数量を加えるならば、

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

のようにすることですか？
そのあたりがあいまいなのですが。

お礼

曖昧な記述になり申し訳ないです。

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

といった感じにできれば。

回答No.9

piroin654

>何故かデータがダブって出てきてしまうところがありました

どのようなことですか？
質問の並べ替えのデータは

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

のように複数のデータがだぶっているので
このような結果がほしいのだろうという意図で
コードを作成しています。あとは単純に
数量をくっつけただけですが。このような
結果だけならば数量を除いてください、と
補足しています。
もし、
　佐藤　みかん　2
　佐藤　みかん　2

ならば、
　佐藤　みかん　2
だけの表示にしたいのであれば
そのようにしますが、
＞上記のようなテーブルがあるのですが、これを下記のようにしたいです
＞種別の隣に数量がきてもOKです。
のような説明があれば、普通はこのように考えるのが
妥当だと思いますが。

回答No.8

山田 太郎（@f_a_007）

【ADOと参照設定】

http://accessvba.pc-users.net/ado/

紹介のサイトを一読下さい。

=========================================
PS、DLookup()関数でもOK!
=========================================

http://www.accessclub.jp/samplefile/help/help_166_1.htm

DBLookup()は、Access が提供している DLookup() のADO版です。

(1)Select文を生で書く。
(2)DLookup()の重さを克服する。

この二つの目的で開発したものでDLookup()の三倍速で動作します。今回は、DLookup()を多用するので高速版であるDBLookup()を利用しています。そういうことですから、該当部分は当然にDLookup() でも書けます。

お礼

ありがとうございます。
DBLookupで問題なく実行することができました。

回答No.7

piroin654

No5です。
「数量」が必要なければ、「テーブルB」の
「数量」フィールドを除き、コードの

　　　rs2!数量 = rs1.Fields(k).Value

をコメントアウトするか、削除してください。
なお、「テーブルB」は、コードを実行すると、

ID　担当者　種別　　　　数量
1　　田中　　りんご　　　1
2　　鈴木　　りんご　　　1
3　　佐藤　　りんご　　　2
4　　田中　　みかん　　　2
5　　佐藤　　みかん　　　1
6　　佐藤　　ぶどう　　　1
7　　鈴木　　バナナ　　　1
8　　佐藤　　バナナ　　　1
9　　田中　　いちご　　　1
10　　鈴木　　いちご　　　1
11　　佐藤　　いちご　　　1
12　　佐藤　　りんご　　　2
13　　田中　　みかん　　　2

のようにデータが格納されます。
当然ながら、数量はたとえば、まちまち
であっても同じことです。

なお、コードについて若干補足しますと、
「テーブルA」は、

名前　りんご　みかん　　ぶどう　　バナナ　　いちご
佐藤　　2　　　　　1　　　　　　1　　　　　1　　　　　1
鈴木　　1　　　　　　　　　　　　　　　　　1　　　　　1
田中　　1　　　　　 2　
　　　　　　　　　　　　　　　　1
のようになっていますが、コードでは「テーブルA」のフィールドを

　　　　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

のようにして追いかけていますが、フィールドのIndexは0から
はじまるので、先頭の「名前」フィールドは　rs1.Fields(0)
です。したがってこの先頭の「名前」フィールドを除くため
For i = 1 To rs1.Fields.Count - 1
のようにして1からデータを取得するようにしています。
その他、あれやこれやの説明が必要であれば、補足してください。

なお、このコードは、フィールドがいくら増えてもこのまま
使用できます。コードを変更する必要はありません。たとえば、
データのフィールドが、

りんご　みかん　　ぶどう　　バナナ　　いちご　メロン　すいか　トマト・・・・

のようになってもこのままです。

IDフィールドは順序を確定するだけなので、順序の確保が必要なければ
IDフィールドを取り除けば単に「横を縦に」というだけのテーブルが
できます。ただ、その場合も基本的なコードはほとんど同じで、
無駄なループをなくすだけです。このままでも使えますが。

お礼

ありがとうございます。
実行はできたのですが、何故かデータがダブって出てきてしまうところがありました。
なぜでしょうか。