Accessで縦に情報が展開されてるテーブルの処理

Question

作業環境は以下の通りで、Accessの知識は初心者です。
OS：Windws7/使用ソフト：Access2003

やりたい事はこれに近いのですが、もう一ひねりある為困っています。
http://oshiete.goo.ne.jp/qa/2452277.html?from=recommend

テーブルに以下のようなデータがあります。
薬剤/配番/効果/使用方法
A剤/00001/頭痛/1回1錠
A剤/00002/発熱/食後…(長文)
B剤/00001/頭痛/1回2錠
B剤/00003/裂傷/清潔な手で…(長文)

これを薬剤名ごとに、効果(数は120を超えます)と使用方法を横へ並べる事はできますか？

30246kiku · Accepted Answer

＃９です

> 実行時エラー'94':
> Nullの使い方が不正です
>
> デバックボタンを押してみると55行目の↓この部分が黄色く反転されました。
> sA(i * 2 - 1) = rs("効果")

おそらく、「効果」にデータが無くて Null になっていると思われます。
※ データ/テーブル内容からすると、何かしら設定されているものと思っていたんですが・・・

対処方法は２つあって、

１）代入する時に Nz 関数を使って Null を ""（空文字）に置換える

>　　　　sA(i * 2 - 1) = rs("効果")
>　　　　sA(i * 2) = rs("使用方法")
↓
　　　　sA(i * 2 - 1) = Nz(rs("効果"))
　　　　sA(i * 2) = Nz(rs("使用方法"))

ただ、これには問題がありそう
というのは、両方値が入っていなければ良いと思いますが、
どちらか一方だけに値が設定されていたら・・・　変な内容に？

２）必ず「効果」「使用方法」両方に値が設定されているものを対象にする

>　　Const CSQL1 As String = "SELECT DISTINCT 配番 FROM {%1};"
>　　Const CSQL2 As String = "SELECT * FROM {%1} ORDER BY 薬剤;"

これで抽出しているわけですが、
条件として「効果」「使用方法」とも設定されているもの・・・ を、追加します。

　Const CSQL1 As String = "SELECT DISTINCT 配番 FROM {%1} " _
　　　& "WHERE 効果 Is Not Null AND 使用方法 Is Not Null;"
　Const CSQL2 As String = "SELECT * FROM {%1} " _
　　　& "WHERE 効果 Is Not Null AND 使用方法 Is Not Null ORDER BY 薬剤;"

これに変更すると、１）での変更は不要です。
けど、念のために１）も適用しておいた方が良いかも

この修正でどうなりますでしょうか

30246kiku · Answer

＃１４です

結果を教えていただき、ありがとうございます

> 単純に入力忘れと思われます
> Nullの配番は様々という事になります

手間を取らせてしまった様で、すみません。
心配性なもので・・・

効果 Null は継続用途？　と疑ったわけですが、
継続のやり方は、
・＃１４での、配番+1 とする方法のほかに、
・同じ薬剤に、同じ配番を存在させ、薬剤を昇順、配番を昇順、効果を降順で並ばせる
が考えられたので、効果 Null の配番も合わせて調べられたら・・・・
と記述したつもりでした
（そう伝わっていなかったら、ごめんなさい）

でも、
> 単純に入力忘れと思われます
であれば、＃１４ の VBA は忘れてください。

また、＃１２の２）は、効果 Null のものを除外していますが、
同じ配番で、例えば、効果が「注意」「ご注意」 Null のものは、
同じ項目「効果xx」で縦に並ぶので、何箇所かが空欄になっていても
前後関係で理解できる？ものなのかと・・・
であれば、２）ではなく、１）の方が良かったりして・・・

・効果 Null のものは除外する
・使用方法だけでも盛り込む

これは、質問者さんの判断になるかと思います。

なお、＃１２の２）での
> AND 使用方法 Is Not Null 
部分は削除しても良いかも

余談）

他ご質問への＃１２を使った展開は、

・配番の順で記述位置を管理するのは同じ。
ただし、見出しに使う文字列は、同一配番での効果の一番短い物を使うとか
同一配番で、例えば、効果が「注意」「ご注意」なら「注意」の方を見出しに

とでもすれば、列数は今回のものの半分程度になるかと・・・

※ 「注意」「ご注意」を別々の列にしようとするから、2000 項目以上になるのかも
※ 単に文字列として見出しを作る事は出来ますが
> 効果(230文字程度、全角文字と半角英数字と-./()・などの記号が含まれる)
より、
他システムが見出しとして解釈できない文字を編集する必要があると思います。
（問題なければ編集は不要ですけど・・・：心配性なもので・・・）

以上　失礼しました

30246kiku · Answer

＃１２です

> 効果のみNull値が存在するようです

これ、結構引っ掛かってました。
＃１２での対処は安易だったかもしれません。

> 使用方法フィールドはメモ型

これを一旦疑う方向で考えてみると・・・
インポートする前のテキストファイル内の使用方法は、
ある程度の文字数で区切られていて・・・
継続する為に、例えば、配番を＋１して、効果を Null
また、使用方法には続きを・・・

こう考えてみると、効果 Null の役割はあるのかな？
※※ 何故、効果の Null が存在するのか確認してください ※※
※ また、効果が Null の配番は何？は、調べておいた方が良いと思います

もしそうであれば、インポートした後に
使用方法を繋げて、効果 Null のものは削除するとか必要だったのかも・・・

現状のデータ状態で、上記の使用方法継続と考えた記述は以下になりますが、
上記推測で文字数で区切ったのには理由があると思うので確認は必須です。

なお、上記推測での使用方法継続を捨てるのなら、＃１２のままでも

＃９からの変更点は、
・配番の順で記述位置を決定する時には、効果が Null じゃないもので
・記述位置を求める際
効果が Null じゃなかったら、それ用の記述位置を求める
効果が Null だったら、前回の位置に
これ用に、変数 iPos
もちろん、効果 Null の出現位置は、配番順と仮定するので
ORDER BY 薬剤, 配番　として、配番の昇順も指定する様に
継続の使用方法は、配番＋１と仮定していましたが、これが外れた場合
順を特定できないので、最悪の場合だけ処理する様に
（配番に -1 が存在するみたいで、何の用途か不明）
（配番は正と、勝手に思い込んでいたので）

Public Function Samp2()
　　Dim dic As Object
　　Dim rs As DAO.Recordset
　　Dim sA() As String
　　Dim sSql As String
　　Dim vSave As Variant
　　Dim iPos As Long, i As Long
　　Dim ffn As Integer
　　Const CTABLE As String = "テーブル名" ' ← 変更要 ★
　　Const CFILE As String = "	estSamp1.csv" ' ← 変更要 ★
　　Const CSQL1 As String = "SELECT DISTINCT 配番 FROM {%1} " _
　　　　　　　　　　　　　　& "WHERE 効果 Is Not Null;"
　　Const CSQL2 As String = "SELECT * FROM {%1} ORDER BY 薬剤, 配番;"

Set dic = CreateObject("Scripting.Dictionary")

sSql = Replace(CSQL1, "{%1}", CTABLE)
　　Set rs = CurrentDb.OpenRecordset(sSql)
　　While (Not rs.EOF)
　　　　dic(rs("配番").Value) = rs.AbsolutePosition + 1
　　　　rs.MoveNext
　　Wend
　　rs.Close
　　Set rs = Nothing

ReDim sA(dic.Count * 2)

ffn = FreeFile()
　　Open CurrentProject.Path & CFILE For Output As #ffn
　　sA(0) = "薬剤"
　　For i = 1 To dic.Count
　　　　sA(i * 2 - 1) = "効果" & i
　　　　sA(i * 2) = "使用方法" & i
　　Next
　　Print #ffn, Join(sA, ",")
　　For i = 0 To UBound(sA)
　　　　sA(i) = ""
　　Next
 
　　sSql = Replace(CSQL2, "{%1}", CTABLE)
　　Set rs = CurrentDb.OpenRecordset(sSql)
　　While (Not rs.EOF)
　　　　If (vSave <> rs("薬剤").Value) Then
　　　　　　If (Not IsEmpty(vSave)) Then
　　　　　　　　For i = 0 To UBound(sA) - 1
　　　　　　　　　　Write #ffn, sA(i),
　　　　　　　　　　sA(i) = ""
　　　　　　　　Next
　　　　　　　　Write #ffn, sA(i)
　　　　　　　　sA(i) = ""
　　　　　　End If
　　　　　　vSave = rs("薬剤").Value
　　　　　　sA(0) = vSave
　　　　　　iPos = 0
　　　　End If
　　　　If (Not IsNull(rs("効果"))) Then iPos = dic(rs("配番").Value)
　　　　If (iPos > 0) Then
　　　　　　i = iPos * 2
　　　　　　sA(i - 1) = sA(i - 1) & rs("効果")
　　　　　　sA(i) = sA(i) & rs("使用方法")
　　　　End If
　　　　rs.MoveNext
　　Wend
　　If (Len(sA(0)) > 0) Then
　　　　For i = 0 To UBound(sA) - 1
　　　　　　Write #ffn, sA(i),
　　　　Next
　　　　Write #ffn, sA(i)
　　End If
　　Close #ffn
　　rs.Close: Set rs = Nothing
　　Set dic = Nothing
End Function

※ 処理速度がどの程度だったのか気になります。
よろしければ、どの位・・・　教えていただければと思います。
レコード：何件、CSV行数：何行、サイズ、何分位・・・とか

NotFound404 · Answer

なるほど・・・。
原因を究明したいところですが、＃９さんの回答でバッチリのようですので
これは私の個人的な宿題とさせていただきます。
つたない回答にお付き合いいただきましたこと恐縮です。

NotFound404 · Answer

処理速度はかなり改善していると思いますが未検証です。
メモリ不足でパンクするかも？
※成否に関わらず結果（エラーメッセージになるかも？）を教えてください。
前回の関数を下記に差し替えてください。
では。

Function JoinCSV()
'要参照設定Microsoft ActiveX DataObject Library 2.5以上
　　Dim Cn As ADODB.Connection
　　Dim RsK As ADODB.Recordset
　　Dim RsS As ADODB.Recordset
　　Dim i As Long, j As Long, k As Long
　　Dim sSql As String
　　Dim FF As Integer
　　Dim RowTmp() As String
　　Dim csvRows() As String
　　Const dLim As String = ""","""
　　Dim csvAll As String
　　
　　Set Cn = CurrentProject.Connection
　
　　Set RsK = New ADODB.Recordset
　　sSql = "TRANSFORM " _
　　　　& "First(Tbl.[効果]) AS 効果の先頭 " _
　　　　& "SELECT Tbl.[薬剤] " _
　　　　& "FROM Tbl " _
　　　　& "GROUP BY Tbl.[薬剤] " _
　　　　& "PIVOT '効果' & Tbl.[配番];"
　　RsK.Open sSql, Cn, adOpenStatic, adLockReadOnly
　
　　Set RsS = New ADODB.Recordset
　　sSql = "TRANSFORM " _
　　　　& "First(Tbl.[使用方法]) AS 使用方法の先頭 " _
　　　　& "SELECT Tbl.[薬剤] " _
　　　　& "FROM Tbl " _
　　　　& "GROUP BY Tbl.[薬剤] " _
　　　　& "PIVOT '使用方法' & Tbl.[配番];"
　　RsS.Open sSql, Cn, adOpenStatic, adLockReadOnly
　
　　ReDim RowTmp(RsK.Fields.Count * 2 - 2)
　　ReDim csvRows(RsK.RecordCount)
　　
　　'ヘッダー取得
　　For i = 0 To RsK.Fields.Count - 1
　　　　RowTmp(j) = RsK.Fields(i).Name
　　　　j = j + 1
　　　　If j > 1 Then
　　　　　　RowTmp(j) = RsS.Fields(i).Name
　　　　　　j = j + 1
　　　　End If
　　Next
　　csvRows(0) = Join(RowTmp, ",")　'配列をJoinで一行に
　　
　　'各データ取得
　　k = 1　 ' 0 はヘッダーで使用済み
　　Do Until RsK.EOF
　　　　ReDim RowTmp(RsK.Fields.Count * 2 - 2)
　　　　j = 0
　　　　For i = 0 To RsK.Fields.Count - 1
　　　　　　RowTmp(j) = IIf(i = 0, """", "") _
　　　　　　　　　　　　& Nz(RsK.Fields(i).Value, "") '最初なら行頭に " を付加
　　　　　　j = j + 1
　　　　　　If j > 1 Then
　　　　　　　　RowTmp(j) = Nz(RsS.Fields(i).Value, "") _
　　　　　　　　　　　　　　& IIf(i = (RsK.Fields.Count - 1), """", "") '最後なら行末 " を付加
　　　　　　　　j = j + 1
　　　　　　End If
　　　　Next
　　　　
　　　　csvRows(k) = Join(RowTmp, dLim)
　　　　'Debug.Print i, csvRows(k)
　　　　k = k + 1
　　　　RsK.MoveNext
　　　　RsS.MoveNext
　　Loop

csvAll = Join(csvRows, vbCrLf)
　　FF = FreeFile
　　Open CurrentProject.Path & "\JoinCSV.csv" For Output As #FF
　　
　　Print #FF, csvAll
　　Close #FF
　
　　RsS.Close: Set RsS = Nothing
　　RsK.Close: Set RsK = Nothing
　　Cn.Close: Set Cn = Nothing
　　Msgbox "終了しました"
End Function

ki073 · Answer

No.9の30246kikuさんに続いて、横からすみません。

データ量ですが、およそ薬剤11万種類×効果120種類というとなのでしょうか？
そうすると1つが100バイトとしても、ファイルサイズで1.3Gバイトかそれ以上となるのでしょうか？

全部読むのはかなり苦しそうですね。A剤が続いていて、それが終わったらB剤になるようにかたまっているのでしたら、順番に読み込んでいって、1薬剤ごとに処理するのが早そうです。（かたまってなければあらかじめソートする）
エクセルであらかじめソートするのも大きすぎて無理なのかな？？

Accessは全くの素人なのですが、インデックスを設定しているのでしょうか？
それともリレーションを設定した時点でインデックスはつくられるのでしょうか？

30246kiku · Answer

おじゃまします

記憶だけなのですが、
一気に書き出し・・・は、ソコソコの文字数であれば速くて
大容量になるとかえって遅くなったような気がします。
（嘘を言っているかもしれません）

大量レコードでのクロス集計２発＆CSV書出しを
クロス集計もどきを自力＆１行毎の書き出しにしてみました。
※ 列の並び順が変わるかも・・・

★ 部分を変更の上実行してみてください。

Public Function Samp1()
　　Dim dic As Object
　　Dim rs As DAO.Recordset
　　Dim sA() As String
　　Dim sSql As String
　　Dim vSave As Variant
　　Dim i As Long
　　Dim ffn As Integer
　　Const CTABLE As String = "テーブル名" ' ← 変更要 ★
　　Const CFILE As String = "	estSamp1.csv" ' ← 変更要 ★
　　Const CSQL1 As String = "SELECT DISTINCT 配番 FROM {%1};"
　　Const CSQL2 As String = "SELECT * FROM {%1} ORDER BY 薬剤;"

Set dic = CreateObject("Scripting.Dictionary")

sSql = Replace(CSQL1, "{%1}", CTABLE)
　　Set rs = CurrentDb.OpenRecordset(sSql)
　　While (Not rs.EOF)
　　　　dic(rs("配番").Value) = rs.AbsolutePosition + 1
　　　　rs.MoveNext
　　Wend
　　rs.Close
　　Set rs = Nothing

ReDim sA(dic.Count * 2)

ffn = FreeFile()
　　Open CurrentProject.Path & CFILE For Output As #ffn
　　sA(0) = "薬剤"
　　For i = 1 To dic.Count
　　　　sA(i * 2 - 1) = "効果" & i
　　　　sA(i * 2) = "使用方法" & i
　　Next
　　Print #ffn, Join(sA, ",")
　　For i = 0 To UBound(sA)
　　　　sA(i) = ""
　　Next
 
　　sSql = Replace(CSQL2, "{%1}", CTABLE)
　　Set rs = CurrentDb.OpenRecordset(sSql)
　　While (Not rs.EOF)
　　　　If (vSave <> rs("薬剤").Value) Then
　　　　　　If (Not IsEmpty(vSave)) Then
　　　　　　　　For i = 0 To UBound(sA) - 1
　　　　　　　　　　Write #ffn, sA(i),
　　　　　　　　　　sA(i) = ""
　　　　　　　　Next
　　　　　　　　Write #ffn, sA(i)
　　　　　　　　sA(i) = ""
　　　　　　End If
　　　　　　vSave = rs("薬剤").Value
　　　　　　sA(0) = vSave
　　　　End If
　　　　i = dic(rs("配番").Value)
　　　　sA(i * 2 - 1) = rs("効果")
　　　　sA(i * 2) = rs("使用方法")
　　　　rs.MoveNext
　　Wend
　　If (Len(sA(0)) > 0) Then
　　　　For i = 0 To UBound(sA) - 1
　　　　　　Write #ffn, sA(i),
　　　　Next
　　　　Write #ffn, sA(i)
　　End If
　　Close #ffn
　　rs.Close: Set rs = Nothing
　　Set dic = Nothing
End Function

やっている事は、
・配番の昇順で、その配番のものは何個目に配置する・・・
これを Dictionary で 1 ～ の連番で管理するようにして
・薬剤順で並べたレコードを順に処理して、
薬剤が変わったら、１行書出し

その途中のデータを作り込む配列が sA
sA(0) には薬剤、sA(1) には 効果1 、sA(2) には 使用方法1
sA(3) ～ は、添え字奇数部分が効果、偶数部分が使用方法

ヘッダの書き出しでは、"" で囲まないとのことなので
sA を ,（カンマ）で繋げたものを Print
以降の行は "" で囲むことから Write
（元のデータが文字列なので "" で囲まれる）
（逆に "" で囲んでもらいたいので String の配列を利用）

※ 大量データでは確認していないので、遅かったりしたらごめんなさい

余談）

大量のデータを順に処理したい時には DAO を使った方が良さそうです
ADO では、全部のデータを用意するまで Open から先に進まないような・・・
DAO では、Open から先に進むまでが速い様な・・・
（私の感覚だけなので、嘘かも）

NotFound404 · Answer

すみません。
#6のコードの後半の
Write #FF ,buf を
Print #FF ,buf 
に修正してください。
これでひとつに収まってしまう問題は解決するハズです。

時間が掛かる件について。
Buf（メモリ）に一旦全て読み込んでから一度にファイルに書き出し・・・
を考えていましたが、１１万レコード位になっているとのことですので
タスクマネージャーで観察するとメモリを厳しく圧迫しているハズです。
改善策を模索中です。（期待しないでください。）
という訳で今晩の回答はお休みさせてください。

NotFound404 · Answer

>３時間かかっても終了せず・・・
途中で強制終了してしまったということでしょうか？
テーブルのレコード数はどれ位でしょう？
あと、Q効果クエリを削除していなければ開いて
左下に、レコード位置/総レコード数が表示されますが
レコード数が表示されるまでの時間と表示された時のレコード数はどれ位でしょう？
Q効果とQ使用方法から中間テーブルを作成してからの方が安全かもしれません。
ただ、私の手に負えないような気がしてきました。。。

NotFound404 · Answer

こんな感じかな。例外処理的なモノ、エラー処理が含まれていません。
Accessデータファイルと同じフォルダにJoinCSV.csv が作成されます。
検証は十分に行ってください。

手順。
Alt + F11 でVBEのウィンドウにします。
メニューのツール → 参照設定 を選択。
ライブラリの一覧が出ますので、Access2003なら
（Microsoft ActiveX DataObject Library 2.5 以降だと思います）
にチェックを入れて、OK で閉じます。

メニュー → 挿入 → 標準モジュール を選択。
新たなウィンドウが出ますので下記コードをコピペ。
メニュー  → デバッグ → ○×△のコンパイルを選択。
何も起きなければ OK です。

Ctrl + S でファイルの上書き保存します。
モジュール名を聞いてくるので、適当な名前を付けてください。
Alt + F4 でVBE を閉じます。

『マクロ』の新規作成から
アクション に「プロシージャの実行」、
下のプロシージャ名に、JoinCSV() とします。
マクロを適当な名前で保存します。
そのマクロを実行すれば、csv ファイルが出来ます（多分）。
なお、クエリ（Q薬剤・Q効果・Q使用方法）は不要です。

Function JoinCSV()
'要参照設定Microsoft ActiveX DataObject Library 2.5以上
　　Dim Cn As ADODB.Connection
　　Dim RsK As ADODB.Recordset
　　Dim RsS As ADODB.Recordset
　　Dim i As Integer
　　Dim sSql As String
　　Dim Buf As String
　　Dim FF As Integer
　　
　　Set Cn = CurrentProject.Connection
　　
　　Set RsK = New ADODB.Recordset
　　sSql = "TRANSFORM " _
　　　　& "First(Tbl.[効果]) AS 効果の先頭 " _
　　　　& "SELECT Tbl.[薬剤] " _
　　　　& "FROM Tbl " _
　　　　& "GROUP BY Tbl.[薬剤] " _
　　　　& "PIVOT '効果' & Tbl.[配番];"
　　RsK.Open sSql, Cn, adOpenStatic, adLockReadOnly
　　
　　Set RsS = New ADODB.Recordset
　　sSql = "TRANSFORM " _
　　　　& "First(Tbl.[使用方法]) AS 使用方法の先頭 " _
　　　　& "SELECT Tbl.[薬剤] " _
　　　　& "FROM Tbl " _
　　　　& "GROUP BY Tbl.[薬剤] " _
　　　　& "PIVOT '使用方法' & Tbl.[配番];"
　　RsS.Open sSql, Cn, adOpenStatic, adLockReadOnly
　　
　　For i = 1 To RsK.Fields.Count
　　　　Buf = Buf & RsK.Fields(i - 1).Name & ","
　　　　If i > 1 Then
　　　　　　Buf = Buf & RsS.Fields(i - 1).Name & ","
　　　　End If
　　Next
　　Buf = Left(Buf, Len(Buf) - 1)
　　
　　Do Until RsK.EOF
　　　　Buf = Buf & vbCrLf
　　　　For i = 1 To RsK.Fields.Count
　　　　　　Buf = Buf & """" & RsK.Fields(i - 1).Value & """" & ","
　　　　　　If i > 1 Then
　　　　　　　　Buf = Buf & """" & RsS.Fields(i - 1).Value & """" & ","
　　　　　　End If
　　　　Next
　　　　
　　　　Buf = Left(Buf, Len(Buf) - 1)
　　　　RsK.MoveNext
　　　　RsS.MoveNext
　　Loop

FF = FreeFile
　　Open CurrentProject.Path & "\JoinCSV.csv" For Output As #FF
　　Write #FF, Buf
　　Close #FF
　　
　　RsS.Close: Set RsS = Nothing
　　RsK.Close: Set RsK = Nothing
　　Cn.Close: Set Cn = Nothing
　　Msgbox "終了しました。"
End Function

Accessで縦に情報が展開されてるテーブルの処理

＃９です

＃１４です

この回答への補足

＃１２です

この回答への補足

なるほど・・・。

処理速度はかなり改善していると思いますが未検証です。

この回答への補足

No.9の30246kikuさんに続いて、横からすみません。

この回答への補足

おじゃまします

すみません。

>３時間かかっても終了せず・・・

こんな感じかな。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング