• 締切済み
  • 困ってます

Access レコードを分割してフォームで表示

Access 2007です。 下記のような日記テーブルがあり、 その「行動」フィールドの中身を「●」の記号で レコードに分割して、 フォームに表示したいと思っています。 日記テーブル ID 年月日   天気  行動 1 2014/1/10  晴  ●読書。●新聞を読む。●散歩。 2 2014/1/11  曇  ●電車に乗る。●新年会。●庭の手入れ。●カラオケ。 3 2014/1/12  曇  ●昼寝。 4 2014/1/13  雨  ●買い物。●読書。 ・・・・ 結果フォーム(データシートビュー)で表示 年月日    行動 2014/1/10  読書。 2014/1/10  新聞を読む。 2014/1/10  散歩。 2014/1/11  電車に乗る。 2014/1/11  新年会。 2014/1/11  庭の手入れ。 2014/1/11  カラオケ。 2014/1/12  昼寝。 2014/1/13  買い物。 2014/1/13  読書。 もとの日記テーブルのデータは変更しません。 下記のように、VBAのコードの中で、 レコードセットを使えば、上記のようなレコードの分割ができると思うのですが、 うまくいきません。 rs2というレコードセットをどうやって作成すればいいのかわかりません。 (Set rs2 = DB.OpenRecordset ・・・ のような行が必要ではないか、と思うのですが、 そのやり方がわかりません。) やり方を教えていただけたら幸いです。 Dim DB As DAO.Database Set DB = CurrentDb() Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Set rs1 = DB.OpenRecordset("日記テーブル", dbOpenForwardOnly) Dim A As Variant Do Until rs1.EOF A = Split(rs1!行動, "●") For i = 1 to UBound(A) rs2.AddNew rs2!年月日 = rs1!年月日 rs2!行動 = rs1!A(i) rs2.Update Next i rs1.MoveNext Loop DoCmd.OpenForm "結果フォーム" Set Forms!結果フォーム.Recordset = rs2

共感・応援の気持ちを伝えよう!

  • 回答数2
  • 閲覧数276
  • ありがとう数8

みんなの回答

  • 回答No.2

No1です。 変数の宣言の順序について述べておきます。 質問では、 Dim DB As DAO.Database Set DB = CurrentDb() Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Set rs1 = DB.OpenRecordset("日記テーブル", dbOpenForwardOnly) これを、No1の回答も加えて、 Dim DB As DAO.Database Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Dim i As Long Set DB = CurrentDb() Set rs1 = DB.OpenRecordset("日記テーブル", dbOpenForwardOnly) Set rs2 = DB.OpenRecordset("結果テーブル", dbOpenDynaset) のように行儀良く並べると見通しがよくなります。

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • テーブルのレコードが0件時にmsg表示(アクセス)

    とてつもない初歩的な質問で すみません! フォーム1をメニュー画面として、 フォーム1にある「ボタン」を押すと テーブルにレコードが追加され、処理が走る・・・という仕様を作っています。 ですが、 このテーブルにレコードが追加されなかった=0件 の場合の回避策を どうしたら良いのかが わかりません。 ちなみに、 Private Sub ボタン_Click() On Error GoTo errmsg DoCmd.SetWarnings False Dim DB As DAO.Database Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Dim i As Long Set DB = CurrentDb Set rs1 = DB.OpenRecordset("テーブル1") Set rs2 = DB.OpenRecordset("テーブル2", dbOpenDynaset) rs1.MoveFirst Do Until rs1.EOF If rs1!フィールドA1 = rs1!フィールドA2 Then rs2.AddNew rs2!ID = rs1!ID rs2!フィールドA = rs1!フィールドA1 rs2!B = rs1!フィールドB rs2!C = rs1!フィールドC rs2.Update End If If rs1!フィールドA1 < rs1!フィールドA2 Then For i = rs1!フィールドA1 To rs1!フィールドA2 Step 1 rs2.AddNew rs2!ID = rs1!ID rs2!フィールドA = i rs2!フィールドB = rs1!フィールドB rs2!フィールドC = rs1!フィールドC rs2.Update Next i End If rs1.MoveNext Loop rs1.Close: Set rs1 = Nothing rs2.Close: Set rs2 = Nothing DB.Close: Set DB = Nothing Call 次処理 errmsg: MsgBox "元データが未投入です。" End Sub としたのですが、 これでは データが投入され、処理が成功=完了した場合にも エラーメッセージが出てしまいました。 ご教示いただけますと幸いです。 お手数をおかけしますが、よろしくお願い致します。

  • 1つのフォームから複数のテーブルにレコード追加をやってみました。

    1つのフォームから複数のテーブルにレコード追加をやってみました。 そこで疑問があるのですが、Connectionは1つでRecordsetは追加するテーブルの数だけOpenが必要なのですか? 一応下記のコードで2つのテーブルにレコードを追加出来たのですが、素人の推測でやってみたので間違っている所がないか見て頂きたいです。 返答よろしくお願いします。 Dim cn As ADODB.Connection Dim rs1 As New ADODB.Recordset Dim rs2 As New ADODB.Recordset Set cn = CurrentProject.Connection Set rs1 = New ADODB.Recordset Set rs2 = New ADODB.Recordset Beep If MsgBox(Format(txt車両コード, "000000") & " " & txt登録番号 & Chr(13) & "を登録しますか?", 33, "確認! 登録") = vbOK Then rs1.Open "T車検証", cn, adOpenKeyset, adLockPessimistic rs2.Open "T所有者", cn, adOpenKeyset, adLockPessimistic rs1.AddNew rs1!車両コード = Me.txt車両コード rs1!登録番号 = Me.txt登録番号 rs1!交付年月日 = Me.txt交付年月日 rs1!初度年月 = Me.txt初度年月 rs1.Update rs2.AddNew rs2!車両コード = Me.txt車両コード rs2!所有者 = Me.txt所有者 rs2.Update rs1.Close: Set rs1 = Nothing rs2.Close: Set rs2 = Nothing cn.Close: Set cn = Nothing MsgBox Format(txt車両コード, "000000") & " " & txt登録番号 & Chr(13) & "を登録しました。", 64, "確認! 登録" End If End Sub

  • accessからsqlserverにアップサイジングしましたが,テーブ

    accessからsqlserverにアップサイジングしましたが,テーブルにデータを入力出来なくなってしまいました。 Dim rs As DAO.Recordset Dim db As DAO.Database Set db = CurrentDb() Set rs = db.OpenRecordset("確認用", dbOpenDynaset) rs.AddNew rs!品番 = Me.品番 rs.Update 上記のようにDAOを介してテーブルにデータを入れていました。 アップサイジングする前は、問題なかったのですが、どういったことが原因になりますでしょうか?

  • 回答No.1

(1) rs2に設定するテーブル名を「結果テーブル」として Set rs2 = DB.OpenRecordset("結果テーブル", dbOpenDynaset) のように設定しておきます。 (2) A = Split(rs1!行動, "●") のようにすると、先頭の「●」を区切り文字として 判定し、先頭の前にないものを文字列とするように なるのでエラーを起こします。そのために文字列の先頭の 「●」を除いた文字列を対象とするために、 A = Split(Right(rs1!行動, Len(rs1!行動) - 1), "●") とします。つまり、たとえば、 「●読書。●新聞を読む。●散歩。」 の、 「読書。●新聞を読む。●散歩。」 を対象とする、ということです。 (3) rs2!行動 = rs1!A(i) この記述は間違いです。単に rs2!行動 = A(i) です。 (4) 変数iが設定されていません。 Dim i As Long を変数宣言しておく。 以上です。なお、 DoCmd.OpenForm "結果フォーム" Set Forms!結果フォーム.Recordset = rs2 については、最初から「結果フォーム」のレコードソースを 「結果テーブル」にしておき、「既定のビュー」を 「データシート」にしておけば、 DoCmd.OpenForm "結果フォーム" だけですが。

共感・感謝の気持ちを伝えよう!

関連するQ&A

  • レコードカウントでレコード追加する

    いつも助けられています。 また宜しくお願いします。 xp sp2 access2003  使用です。 今回二つのテーブルにレコード追加をしたく、クリックすると追加できるように見よう見まねで書いたのですが、テーブルに既に主キーがあれば追加しないようにrecordcountで分岐したいのですが、 フィルタで0件のはずがrecordcountは1になってしまいます。また、1件以上あるはずでも1になります。 テーブルAAA: 主nom、加nom、名前、数量  (主と加が主キーです。) テーブルBBB: ID、主nom、加nom、事由、日 (IDがオートナンバで主キーです。) フォームには 主nom1&#65374;主nom10、加nom1&#65374;加nom10、名前、数量、事由、日 の非連結テキストボックスがあります。 ご助言お願いします。 Private Sub 新規登録_Click() Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Dim db As DAO.Database Dim i As Integer i = 1 Set db = CurrentDb Set rs1 = db.OpenRecordset("AAA", dbOpenDynaset) Set rs2 = db.OpenRecordset("BBB", dbOpenDynaset) Do While Me.Controls("加nom" & i) <> "" rs1.Filter = "[主nom]=" & Me.主nom & "and [加nom]=" & Me.Controls("加nom" & i) If rs1.RecordCount = 0 Then                           ←ココがうまくいかない rs1.AddNew rs1!主nom = Me.主nom rs1!加nom = Me.Controls("加nom" & i) rs1!名前 = Me.名前 rs1!数量 = Me.Controls("数量" & i) rs1.Update End If rs2.AddNew rs2!主nom = Me.主nom rs2!加nom = Me.Controls("加nom" & i) rs2!事由 = Me.事由 rs2!日 = Me.日 rs2.Update End If i = i + 1 Loop rs1.Close rs2.Close End Sub

  • 空欄を含む項目のレコードセット

    Access 2003 DAO.Recordsetにてデータを取得しようと思うのですが テーブル項目に空欄がある場合はどのように書けばよろしいのでしょうか? Dim DB As DAO.Database Dim RS As DAO.Recordset Set DB = CurrentDb Set RS = daoDB.OpenRecordset("Aテーブル", dbOpenDynaset) RS.AddNew daoRS!ああ ああ = xx RS!Update ・・・ とするとエラーになります。 項目名"ああ ああ"はどのように書けばいいのでしょうか? よろしくおねがいします。

  • DAOでレコード数を取得したい(ACESSVBA)

    レコードの行数は複数あるのに --------------------------------------------------------- Sub あ() Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("T_test", dbOpenDynaset) MsgBox rs.RecordCount Set rs = Nothing Set db = Nothing End Sub --------------------------------------------------------- これでレコード数を取得しようとすると1がかえるのですが なぜレコードの行数を取得できないのでしょうか?

  • AccessSQL COUNT文で該当レコード抽出したい

    初心者です。 Access2000であるテーブルの条件に一致した レコード件数を抽出するSQLを作成しました。 条件に該当しない場合も1件で件数が戻ってきてしまいます。 AccessクエリでSQLを貼り付けて 検証した場合はちゃんと0件になるのですが VBAのコードではうまく件数が抽出されません。 簡単なことだったらごめんなさい。 いろいろなサイトで探した末、 どうしても解決できないので ご教授よろしくお願いします。 Dim strSQL As String Dim db As DAO.Database Dim rs As DAO.Recordset  Dim IntCount As integer 'SQL文を生成 strSQL = "SELECT COUNT(*) AS 件数 FROM テーブル名 " strSQL = strSQL & "WHERE テーブル名.コード = '" strSQL = strSQL & Forms![フォーム名]![txtコード] strSQL = strSQL & "' AND Left([テーブル名]![区分],1) = '" strSQL = strSQL & Forms![フォーム名]![cnb種類].Column(0) strSQL = strSQL & "' AND テーブル名.名称 = '" strSQL = strSQL & Forms![フォーム名]![txt名称] strSQL = strSQL & "';" Set db = CurrentDb Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) IntCount =  rs.RecordCount rs.Close Set db = Nothing Set rs = Nothing

  • レコード件数が返らない理由がわからない

    テーブル1にはレコードが5件入ってるのですが Private Sub レコード件数() Dim strSQL As String Dim rs As DAO.Recordset strSQL = "SELECT * FROM テーブル1;" Set rs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset) Debug.Print rs.RecordCount End Sub これをすると1が返るのですがなぜでしょうか? レコードの数が返ると思ってるのですが違うのでしょうか?

  • Access VBA(データを横並べで追加)について

    いつもお世話なっております。なかなか解決できなくて、ヘルプ求めにきました。  OS- XP SP2 ACCESS2003 T1(テープル) ID    店名 連番 ----------------------- 1 A 1 2 A 2 3 A 3 4 B 4 5 B 5 6 B 6 7 C 7 8 C 8 9 C 9 ---------------------------- T2(空) ID(オート)店名1  店名2 ----------------------------- T1の店名をT2へ横並べて追加したいので、↓のようににソースを書きました。 希望結果↓ ID(オート)店名1 店名2 ----------------------- 1 A A 2 A B 3 B B 4 C C 5 C Private Sub コマンド0_Click() Dim db As DAO.Database Dim RS1 As Recordset Dim RS2 As Recordset Dim fld As Field Dim A As Integer Set db = CurrentDb() Set RS1 = db.OpenRecordset("T1", dbOpenTable) Set RS2 = db.OpenRecordset("T2", dbOpenTable) RS1.MoveFirst For A = 1 To RS1.RecordCount If RS1![連番] Mod 2 <> 0 Then RS2.AddNew RS2![店名1] = RS1![店名] ElseIf RS1![連番] Mod 2 = 0 Then RS2![店名2] = RS1![店名] RS2.Update End If RS1.MoveNext Next MsgBox "終わり", vbExclamation RS1.Close RS2.Close End Sub 質問1-自分のこの書き方でデータ店名のCが一つ消えてしまいます。原因を教えてください。 質問2-後、店名が変わる時、店1からスタートさせたいですが、どうすれば、いいんでしょうか。 希望結果↓ T2 ID    店名1   店名2 ----------------------------- 1 A A 2 A 3 B B 4 B 5 C C 6 C

  • Access97でのエラー

    フォームを開くときに次のVBAを実行します。 Private Sub Form_Open(Cancel As Integer) Dim db As DAO.DATABASE Dim rs As DAO.Recordset Set db = CurrentDb ところが、Set db = CurrentDb の行で次のエラーが出ます。 実行時エラー '429' ActiveXコンポーネントはオブジェクトを作成できません。 ちなみに、これを作成したのは他のパソコンで、そのパソコンでは問題なく実行します。 Windows2000のパソコンにコピーして実行しようとするとダメです。 どなたかおわかりの方、いらっしゃいましたら、教えていただけないでしょうか?

  • フォーム内で複数のレコードを表示

    アクセスで、表形式のサブフォーム(S_フォーム)を作成し、データを入力するとテーブル(T_明細)に追加されるようになっています。これをサブフォームのテキストボックスに入力するのではなく、別のクエリ(Q_クエリ)にあるデータを実行ボタンを押すことでサブフォームのテキストボックスに表示するようにし、テーブルのレコード(何件もある)を入力させていきたいと思っています。下記のようにコードをまず作成してみました。 Public Db As Database Public rs As Recordset Private Sub 実行_Click() Dim Temp_count As Integer Dim I As Integer Set Db = CurrentDb Set rs = Db.OpenRecordset("Q_クエリ", dbOpenDynaset) Temp_count = DCount("ID", "Q_クエリ") For I = 1 To Temp_count If IsNull(rs![氏名]) = False Then 氏名テキスト = rs![氏名] If IsNull(rs![住所]) = False Then 住所テキスト = rs![住所] rs.MoveNext Next I End Sub すると、ループした内容が全て同じテキストボックスに上書きされていき、結局1つのレコードしか追加できない状態です。入力操作でENTERしていくとサブフォーム内で複数のレコードが入力出来るように、出来ないでしょうか??良い記述があれば教えてください。お願い致します。

  • VB テーブルのデータを出荷先ごとにcsv出力

    お世話になります。 VBは素人で、自分なりにネットでいろいろ調べて、下記の物を作ってみたのですが、 うまくいかず、とても悩んでおります。 知ってる方、どなたか教えて頂けませんか? よろしくお願いいたします。m(_ _)m ------------------------------------------------------------------ 目的: (1)テーブルのフィルド名を、各CSVの一行目に出力したい。 (2)テーブルのフィルドは30項目ぐらいあるため、下記のように個別出力ではなく、   一括で出力できるようにしたいです。 (3)すべての項目には、” ”で囲み、カンマで区切りをしたいです。 ------------------------------------------------------------------ Option Compare Database Option Explicit Private objDB As DAO.Database Private objExcel As Object 'EXCELオブジェクト Private objWorkBook As Object 'WORKBOOKオブジェクト Private objSheet As Object 'SHEETオブジェクト Public Sub CSVsyuturyoku() Dim db As DAO.Database Dim rs1 As DAO.Recordset Dim rs2 As DAO.Recordset Dim flag As Boolean Set db = CurrentDb Set rs1 = db.OpenRecordset("SELECT DISTINCT 氏名 FROM 出荷データ") Do Until rs1.EOF Set rs2 = db.OpenRecordset("SELECT * FROM 出荷データ" _ & " WHERE Nz(氏名) = '" & rs1!氏名 & "'") flag = True Open CurrentProject.Path & "\ファイル" & rs1!氏名 & ".csv" _ For Output As #1 Do Until rs2.EOF 'Print #1, Nz(rs2!商品名) Print #1, rs2!商品コード & "," & rs2!商品名 & "," & rs2!単価 ' ↑フィルド項目数が多すぎたため、全部書ききらず。。。 rs2.MoveNext Loop Close #1 rs1.MoveNext Loop rs1.Close: Set rs1 = Nothing If flag Then rs2.Close: Set rs2 = Nothing db.Close: Set db = Nothing ' 終了の表示 MsgBox "ファイル出力が完了しました。" End Sub

  • AccessのフォームでAND検索

    Accessで今、土地物件を検索するものを作っています。 物件はテーブルに200件くらいあります。 そのテーブルのフィールドに「土地面積(坪)」と「価格」いう名前のフィールドがあるのですが、この2つは【○○~○○】という具合にフォームでボタンを押せば範囲検索が出来るようになっています。 だけど、OR条件になってしまいます。 出来れば、それをAND条件で検索できる様にしたいのです。 ソースは今このようになっています↓↓ テキスト:「tubo1」「tubo2」「kakaku1」「kakaku2」 Private Sub コマンド55_Click() Dim db As DAO.Database Dim rs As DAO.Recordset Set db = CurrentDb Set rs = db.OpenRecordset("物件情報", dbOpenDynaset) If tubo1 <> "" Then If tubo2 <> "" Then    rs.Filter = "[土地面積(坪)] >=" & tubo1 & " And [土地面積(坪)] <=" & tubo2 Else rs.Filter = "[土地面積(坪)] =" & tubo1 End If If kin1 <> "" Then If kin2 <> "" Then rs.Filter = "[価格] >=" & kakaku1 & " And [価格] <=" & kakaku2 Else rs.Filter = "[価格] =" & kakaku1 End If End If End If Set rs = rs.OpenRecordset Set Me.Recordset = rs Me.Requery Set rs = Nothing Set db = Nothing End Sub です。宜しくお願い致します。 ちなみにAccess2007です。