access入所退所日のデータから日数分データ追加

access初心者です。現在以下のようなテーブルがあります。
　　　　　　　　　　入所日　　　退所日
宿泊者ID（A1）　2015/01/01　2015/01/10　

この場合新規テーブルに　
　　　　　　　　　滞在期間
宿泊者ID（A1）　2015/01/01
宿泊者ID（A1）　2015/01/02
宿泊者ID（A1）　2015/01/03
　　　　　　　　：
宿泊者ID（A1）　2015/01/10
という具合に新規追加するには、どのような手法が考えられますでしょうか？
提示情報が足りないと思うのですが、その点のご教授もお願い申し上げま。

No.9 ベストアンサー 回答者： f_a_007 回答日時： 2015/01/08 22:39

【お知らせ】

　　　　　　If M > 99 Then
　　　　　　　　MsgBox "読込む行総数を100行に下方修正しました。(DBSelect)", _
　　　　　　　　　　　 vbInformation, _
　　　　　　　　　　　 " お知らせ"
　　　　　　　　M = 99
　　　　　　End If

DBSelect()に99行制限をかけていました。この６行はバッサリと消して下さい。500行や1000行では変数オーバーはしないので大丈夫です。

この回答へのお礼

とても詳細なご回答に、感動しております。access初心者の自分には、身に余る情報です。ひとつづつ書き写して実行してみたいと考えております。いつの日かf_a_007様のように、ご教授できる立場になれるよう努力していきます。本当に有難うございました。

お礼日時：2015/01/09 01:33

No.8 回答者： f_a_007 回答日時： 2015/01/08 22:35

【4/4】CutStr()

VBAコードを書く上で必須な関数がCutStr()です。

Public Function CutStr(ByVal Text As String, _
　　　　　　　　　　　　ByVal Separator As String, _
　　　　　　　　　　　　ByVal N As Integer) As String
　　Dim strDatas() As String
　　
　　strDatas = Split("" & Separator & Text, Separator, , 0)
　　CutStr = strDatas(N * Abs(N <= UBound(strDatas)))
End Function

非常に短い簡単な関数ですが役に立ちます。

PS、では、頑張ってください。

No.7 回答者： f_a_007 回答日時： 2015/01/08 22:27

【3/4】DBSelect()

AccessにはSELECT文の実行結果を戻す関数がありません。ですから、標準モジュールに次のような関数を登録する必要があります。なお、DBSelect()はADOを使っていますのでVBエディタ[ツール]-[参照設定]を行う必要があります。このDBSelect()がなければ、先のVBAコードはちょっと複雑になるかと思います。そういう意味では、便利なそれです。

Public Function DBSelect(ByVal strQuerySQL As String, Optional strPause As String = ";") As Variant
On Error GoTo Err_DBSelect
　　Dim I　　　　　 As Integer
　　Dim J　　　　　 As Integer
　　Dim R　　　　　 As Integer　　' DataValue(,) のインデックスを決める行カウンター
　　Dim C　　　　　 As Integer　　' DataValue(,) のインデックスを決める列カウンター
　　Dim M　　　　　 As Integer　　' DataValue(,) の一つ目の添字の最大値=行総数 - 1
　　Dim N　　　　　 As Integer　　' DataValue(,) の二つ目の添字の最大値=列総数 - 1
　　Dim rst　　　　 As ADODB.Recordset
　　Dim fld　　　　 As ADODB.Field
　　Dim strList　　 As String　　 ' 全てのデータをセミコロン(;)等で区切った文字列に
　　
　　Set rst = New ADODB.Recordset
　　' =================
　　'　Begin With: rst
　　' -----------------
　　With rst
　　　　.Open strQuerySQL, _
　　　　　　　CurrentProject.Connection, _
　　　　　　　adOpenStatic, _
　　　　　　　adLockReadOnly
　　　　If Not .BOF Then
　　　　　　' --------------
　　　　　　'　配列を再宣言
　　　　　　' --------------
　　　　　　M = .RecordCount - 1
　　　　　　N = .Fields.Count - 1
　　　　　　If M > 99 Then
　　　　　　　　MsgBox "読込む行総数を100行に下方修正しました。(DBSelect)", _
　　　　　　　　　　　 vbInformation, _
　　　　　　　　　　　 " お知らせ"
　　　　　　　　M = 99
　　　　　　End If
　　　　　　ReDim dataValues(M, N)
　　　　　　' ------------------------------------
　　　　　　'　列情報を For-Next で配列に代入する
　　　　　　' ------------------------------------
　　　　　　.MoveFirst
　　　　　　For R = 0 To M
　　　　　　　　C = -1
　　　　　　　　For Each fld In .Fields
　　　　　　　　　　With fld
　　　　　　　　　　　　C = C + 1
　　　　　　　　　　　　dataValues(R, C) = .Value
　　　　　　　　　　End With
　　　　　　　　Next fld
　　　　　　　　.MoveNext
　　　　　　Next R
　　　　Else
　　　　　　ReDim dataValues(0, 0)
　　　　　　dataValues(0, 0) = ""
　　　　　　strList = ""
　　　　End If
　　End With
　　' ---------------
　　'　End With: rst
　　' ===============
　　' -------------------------------
　　'　区切子(;)で連結して１文に
　　' -------------------------------
　　For I = 0 To M
　　　　For J = 0 To N
　　　　　　strList = strList & dataValues(I, J) & strPause
　　　　Next J
　　　　strList = strList & Chr(13)
　　Next I
Exit_DBSelect:
On Error Resume Next
　　rst.Close
　　Set rst = Nothing
　　DBSelect = Replace(strList & "[END]", Chr(13) & "[END]", "")
　　Exit Function
Err_DBSelect:
　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBSelect)" & Chr$(13) & Chr$(13) & _
　　　　　　"・Err.Description=" & Err.Description & Chr$(13) & _
　　　　　　"・SQL Text=" & strQuerySQL, _
　　　　　　vbExclamation, " 関数エラーメッセージ"
　　Resume Exit_DBSelect
End Function

添付図は、DBSelect()の実行結果と必要な参照設定を案内するものです。

No.6 回答者： f_a_007 回答日時： 2015/01/08 22:11

【補足 2/4】メッセージ関数。

以下は、アプリケーションで出力するメッセージの体裁を統一するための関数です。この僅かな関数で、かなりVBAコードをシンプルに書く事ができます。私は、vbInformation、vbExclamation の綴りを暗記できないので随分と助かっています。

Public Function Verify(ByVal Msg As String, _
　　　　　　　　　 Optional ByVal DefaultButton As Integer = vbDefaultButton1) As Integer
　　Verify = MsgBox(Msg, vbYesNo + vbQuestion + DefaultButton, " 確認")
End Function

Public Sub Message(ByVal Msg As String)
　　MsgBox Msg, vbInformation, " お知らせ"
End Sub

Public Sub Warning(ByVal Msg As String)
　　MsgBox Msg, vbExclamation, " 警告"
End Sub

Public Sub StopMsg(ByVal Msg As String)
　　MsgBox Msg, vbCritical, " 致命的なエラー発生のお知らせ"
End Sub

Public Sub ErrorMsg(ByVal Msg As String)
　　MsgBox Msg, vbExclamation, " エラー発生のお知らせ"
End Sub

No.5 回答者： f_a_007 回答日時： 2015/01/08 21:59

【補足 1/4】VBAコードの最終版。

私は、IT業界とは縁もゆかりもない素人プログラマ。ですから、批判的な視点を堅持されて参考にされて下さい。関数等の紹介も含めて４回に分けて補足します。一回目は、VBAコードの最終版です。先ずは、全体の流れを把握なさって下さい。

Option Compare Database
Option Explicit

Private Sub コマンド_滞在日一覧更新_Click()
　　Dim I　　　　　As Integer
　　Dim Answer　　 As Integer
　　Dim N　　　　　As Integer
　　Dim lngID　　　As Long
　　Dim recDatas() As String
　　Dim strSQL　　 As String
　　Dim strInsert　As String
　　Dim strGuestID As String
　　Dim dteSHiduke As Date
　　Dim dteEHiduke As Date
　　
　　Answer = Verify("[滞在日一覧]を一新していいですか？")
　　If Answer = vbYes Then
　　　　DoCmd.SetWarnings False
　　　　' -----------------------------------------
　　　　'　[滞在日一覧]を削除
　　　　' -----------------------------------------
　　　　DoCmd.RunSQL "DELETE * FROM 滞在日一覧"
　　　　' -----------------------------------------
　　　　'　[入退所管理台帳]の全レコード取得
　　　　' -----------------------------------------
　　　　strSQL = "SELECT 宿泊者_ID, 入所日, 退所日 FROM 入退所管理台帳 " & _
　　　　　　　　 "ORDER BY 宿泊者_ID, 入所日"
　　　　recDatas() = Split(DBSelect(strSQL), Chr(13))
　　　　' -----------------------------------------
　　　　'　[滞在日一覧]に新しく追加
　　　　' -----------------------------------------
　　　　N = UBound(recDatas, 1) ' 行数 - 1
　　　　strSQL = "INSERT INTO 滞在日一覧 VALUES (<X>, <Y>, <Z>);"
　　　　For I = 0 To N
　　　　　　strGuestID = CutStr(recDatas(I), ";", 1)
　　　　　　dteSHiduke = CutStr(recDatas(I), ";", 2)
　　　　　　dteEHiduke = CutStr(recDatas(I), ";", 3)
　　　　　　If dteSHiduke <= dteEHiduke Then
　　　　　　　　Do
　　　　　　　　　　lngID = lngID + 1
　　　　　　　　　　strInsert = strSQL
　　　　　　　　　　strInsert = Replace(strInsert, "<X>", lngID)
　　　　　　　　　　strInsert = Replace(strInsert, "<Y>", "'" & strGuestID & "'")
　　　　　　　　　　strInsert = Replace(strInsert, "<Z>", "#" & dteSHiduke & "#")
　　　　　　　　　　DoCmd.RunSQL strInsert
　　　　　　　　　　dteSHiduke = dteSHiduke + 1
　　　　　　　　Loop Until dteSHiduke > dteEHiduke
　　　　　　Else
　　　　　　　　ErrorMsg "処理不能のレコードが見つかりました。"
　　　　　　End If
　　　　Next I
　　　　' -----------------------------------------
　　　　'　終了メッセージ
　　　　' -----------------------------------------
　　　　Message lngID & " 件のレコードを追加しました。"
　　　　DoCmd.SetWarnings True
　　End If
End Sub

１、Access の警告を非表示に。

DoCmd.SetWarnings False

これは、コメントアウトされたら意味が判ります。

２、DBSelect(strSQL)の戻り値

A1;2015/01/01;2015/01/10
A2;2015/01/11;2015/01/20

Select文の結果を列は";"で区切り、行はChr(13)で区切って戻します。

３、recDatas() = Split(DBSelect(strSQL), Chr(13))

recDatas(0)="A1;2015/01/01;2015/01/10"
recDatas(1)="A2;2015/01/11;2015/01/20"

Split()は、指定した区切子で分割して配列変数に取り込みます。

４、Do-Loop Until

Do
　　・・・・・
　　dteSHiduke = dteSHiduke + 1
Loop Until dteSHiduke > dteEHiduke

　これで、入所日から退所日までを順次にINSERTすることができます。なお、日付の加算については添付図を参照されて下さい。

※主な訂正！

strSDate⇒dteSHiduke

文字列型は strSDate
日付型は dteSHiduke

と、サブスクリプトのミスを訂正しました。

No.4 回答者： f_a_007 回答日時： 2015/01/08 18:02

私ならVBAで目的を達成します。

フォームにコマンドボタンを配置して実行します。実行結果は、添付図のようです。

<VBA サンプル＞

Option Compare Database
Option Explicit

Private Sub コマンド_滞在日一覧更新_Click()
　　Dim I　　　　　As Integer
　　Dim Answer　　 As Integer
　　Dim N　　　　　As Integer
　　Dim lngID　　　As Long
　　Dim recDatas() As String
　　Dim strSQL　　 As String
　　Dim strInsert　As String
　　Dim strGuestID As String
　　Dim strSDate　 As Date
　　Dim strEDate　 As Date
　　
　　Answer = Verify("[滞在日一覧]を一新していいですか？")
　　If Answer = vbYes Then
　　　　DoCmd.SetWarnings False
　　　　' -----------------------------------------
　　　　'
　　　　'　[滞在日一覧]を削除
　　　　'
　　　　' -----------------------------------------
　　　　DoCmd.RunSQL "DELETE * FROM 滞在日一覧"
　　　　' -----------------------------------------
　　　　'
　　　　'　[入退所管理台帳]の全レコード取得
　　　　'
　　　　'　ID___________主キー
　　　　'　宿泊者_ID____テキスト型
　　　　'　入所日_______日付型
　　　　'　退所日_______日付型
　　　　'
　　　　' -----------------------------------------
　　　　strSQL = "SELECT 宿泊者_ID, 入所日, 退所日 FROM 入退所管理台帳 " & _
　　　　　　　　 "ORDER BY 宿泊者_ID, 入所日"
　　　　recDatas() = Split(DBSelect(strSQL), Chr(13))
　　　　' -----------------------------------------
　　　　'
　　　　'　[滞在日一覧]に新しく追加
　　　　'
　　　　'　ID___________主キー
　　　　'　宿泊者_ID____テキスト型
　　　　'　滞在日_______日付型
　　　　'
　　　　'　resDatas --- A1;2015/01/01;2015/01/20
　　　　'
　　　　' -----------------------------------------
　　　　N = UBound(recDatas, 1) ' 行数 - 1
　　　　strSQL = "INSERT INTO 滞在日一覧 VALUES (X, YYYYY, ZZZZZ);"
　　　　For I = 0 To N
　　　　　　strGuestID = "'" & CutStr(recDatas(I), ";", 1) & "'"
　　　　　　strSDate = CutStr(recDatas(I), ";", 2)
　　　　　　strEDate = CutStr(recDatas(I), ";", 3)
　　　　　　If strSDate <= strEDate Then
　　　　　　　　Do
　　　　　　　　　　lngID = lngID + 1
　　　　　　　　　　strInsert = strSQL
　　　　　　　　　　strInsert = Replace(strInsert, "X", lngID)
　　　　　　　　　　strInsert = Replace(strInsert, "YYYYY", strGuestID)
　　　　　　　　　　strInsert = Replace(strInsert, "ZZZZZ", "#" & strSDate & "#")
　　　　　　　　　　DoCmd.RunSQL strInsert
　　　　　　　　　　strSDate = strSDate + 1
　　　　　　　　Loop Until strSDate > strEDate
　　　　　　Else
　　　　　　　　ErrorMsg "処理不能のレコードが見つかりました。"
　　　　　　End If
　　　　Next I
　　　　' -----------------------------------------
　　　　'　終了メッセージ
　　　　'
　　　　' -----------------------------------------
　　　　Message lngID & " 件のレコードを追加しました。"
　　　　DoCmd.SetWarnings True
　　End If
End Sub

仮に、VBAにチャレンジするのであれば、更に、ここで用いている幾つかの関数について補足します。

この回答への補足

f_a_007様、たびたび事細かくご説明頂きまして、心より感謝申し上げます。今後の為にも是非VBAにチャレンジしたいと考えております。関数につきまして、ご教授して頂けませんでしょうか？
厚かましいお願いではございますが、どうぞよろしくお願い申し上げます

補足日時：2015/01/08 21:23

No.3 回答者： m3_maki 回答日時： 2015/01/08 17:56

> どのような手法が考えられますでしょうか？

・DAO で 新規テーブルに、ゴリゴリ追加していく。
宿泊者IDでループ
（入所日からスタート 、1日加算しながら開所日まで
新規レコードに、宿泊者ID・滞在期間を書き込む。


・VBA を使わずにクエリだけで。

数字だけのテーブルを用意します（図のテーブル【日数】です）

宿泊日数
0
1
2
・
・
99　<-　予測される期間の最大日数＋余裕

元のテーブル（図のテーブル【入所期間】です） と 数字だけのテーブルで選択クエリを作成します。
テーブルの結合はしません。

新しいフィールドを追加します。
滞在期間: [入所日]+[宿泊日数]

抽出条件に
<=[退所日]

これで、ご希望のデータが得られます。


あとは、クエリデータをそのまま使用するなり
テーブル作成クエリ、追加クエリ、データのコピペ等
お好きなように料理してください。

この回答へのお礼

希望するデータを取得することができました。誠にありがとうございます。

お礼日時：2015/01/08 21:18

No.2 回答者： f_a_007 回答日時： 2015/01/08 12:59

http://access-sql.seesaa.net/category/2945209-1. …
http://makoto-watanabe.main.jp/access/dasqlinser …

INSERT INTO 滞在日一覧 VALUES (1, "A1", #2015/01/01#);

この INSERT文で添付図のようにレコードが挿入（生成）されます。
だとすれば、VBA で

INSERT INTO 滞在日一覧 VALUES (X, "A1", YYYYY);

X と YYYYY とを置換して連続的に実行すれば目的は達成されます。

INSERT INTO 滞在日一覧 VALUES (1, "A1", #2015/01/01#);
INSERT INTO 滞在日一覧 VALUES (2, "A1", #2015/01/02#);
・・・・・
INSERT INTO 滞在日一覧 VALUES (10, "A1", #2015/01/10#);

この回答への補足

早速のご回答に、感謝申し上げます。細かくご指示頂いて、恐縮です。上記yambejp様にも、補足説明をさせて頂いたのですが、宿泊者500人、つまり入院ベッドが500床あるのですが、入所日、退所日はそれぞれまちまちで、それらのベッド稼働率を調べようと思って、ご質問させて頂きました。つまり宿泊者IDはベッドIDと連結されております。ピボットテーブルにて行見出しをベッドID、列見出しを日付、データ分布を上記滞在期間として抽出できないものかと考えております。説明がつたなくてお手数をおかけして申し訳ございませんが、どうぞよろしくお願い申し上げます。

補足日時：2015/01/08 15:43

No.1 回答者： yambejp 回答日時： 2015/01/08 12:12

カレンダーテーブルをつくって（たとえば10年分の日付けをつくっても高々4,000件弱）、

日付 BETWEEN 入所日 AND 対処日

で抽出したデータを新規テーブルに流し込んでやればどうでしょう？

この回答への補足

早速のご回答、感謝申し上げます。まだ初心者なので、十分理解できないのですが、500人の患者が入院しているとして（宿泊者ID×500）、入院日、退院日はそれぞれバラバラになり、年をまたぐ方、月をまたぐ方、がいらっしゃいます。そのうえで行う場合は、どのようになりますでしょうか？お手数をおかけしますが、どうぞよろしくお願い申し上げます。

　　　　　　　　　　　入所日　　　退所日
宿泊者ID（A1）　　2015/01/01　2015/01/10
宿泊者ID（A2）　　2014/11/25　2015/01/05
宿泊者ID（A3）　　2015/01/03　2015/01/07
　　　：
　　　：
宿泊者ID（A500）　2014/12/20　2015/01/25
この場合新規テーブルに　
　　　　　　　　　滞在期間
宿泊者ID（A1）　2015/01/01
宿泊者ID（A1）　2015/01/02
宿泊者ID（A1）　2015/01/03
　　　　　　　　：
宿泊者ID（A1）　2015/01/10
　　　　　　　　：
　　　　　　　　：
宿泊者ID（A500）2014/12/20
　　　　　　　　：
　　　　　　　　：
宿泊者ID（A500）2015/01/25
という具合に新規追加するには、どのような手法がよろしいのでしょうか？

補足日時：2015/01/08 15:30