Access VBA 特定のフィールド＆レコードのデータ複製

Question

###AccessのVBAにてテーブルの特定のフィールド＆レコードのデータを複製する
AccessのVBAにてcsvのデータをテーブルに取り込み後、特定のフィールドにて格納されているデータを同一フィールドのデータが格納されていないレコードにデータの複製はできますでしょうか？

#####ｃｓｖの中身

日付	社員番号	金額
2019/04/01
	2225	5,000
	2240	10,000
	2273	2,000

ｃｓｖに出力するデータの都合でこのようになっています。

#####データ複製後のテーブル

日付	社員番号	金額
2019/04/01	2225	5,000
2019/04/01	2240	10,000
2019/04/01	2273	2,000

日付のデータを社員番号が格納されているフィールドに複製し、代わりに、日付データのみのフィールドを削除するという流れです。

 'テキストファイルを取り込む
  DoCmd.TransferText acImportDelim, "IN 金額合計", "T01_金額合計" _
    , "C:\Users\Documents\01-1 売上管理\01 金額合計.txt"

  '金券カードテーブルを開く
  Set db = CurrentDb()
  Set rs = CurrentDb.OpenRecordset("T01_金額合計", dbOpenTable)
  ReDim vArray(rs.RecordCount - 1, 2)
  i = 0

  '最後のレコードまで繰り返す
  Do Until rs.EOF
    '有効な社員番号かつ取引がある場合
    If (rs(1) >= 2200 And rs(1) <= 2473) And rs(2) > 0 Then
      rs.Edit
      '取引番号の初期値として『９９９９９』を出力する
      rs(3) = "99999"
      '変更をアップデートする
      rs.Update
    Else
      If IsDate(rs(0)) And i = 0 Then
        i = 1
      Else
        'レコードを削除する
        rs.Delete
      End If
    End If
    '次のレコードに移動する
    rs.MoveNext
  Loop

Comments

[coco_bauer]

csvファイルの１行目は日付のみが入っていて、２行目以降は日付以外の２項目が入っている、という事ですか？　それとも、日付のみの行があって、その後に日付以外が入っている行が続いて、というパターンが繰り返されているのでしょうか？

[Yoshikun_0945]

1行目は必ず日付のみで、2行目以降がデータとなり、データが約20行ほどあったのちに、また日付行、データ行×約20行という感じです。

[sazi]

厄介な仕様ですね。

[Yoshikun_0945]

元データ(Csvに出力する電子データ)の都合で・・・。申し訳ありません。

[sazi]

前の質問でのファイルごとの日付もこの仕様では見直しが必要にならないのですか？

Answer 1

更新クエリーで更新したのちに、不要なデータを削除クエリーで削除します。
[更新クエリー]

UPDATE インポートテーブル 
SET 日付 = DLookUp("日付","インポートテーブル","日付 is not null and 社員番号 is null")
WHERE 日付 Is Null

[削除クエリー]

delete from インポートテーブル
WHERE 社員番号 Is Null

追記

1行目は必ず日付のみで、2行目以降がデータとなり、データが約20行ほどあったのちに、また日付行、データ行×約20行という感じです。

この仕様の場合、日付の入力があるものがヘッダーで、日付が無いものがデータという括りになり、データがどのヘッダーに含まれるかを識別する必要があります。
ですので、基本的にCSVを順読みするしかありません。
テーブルにインポートする場合はオートナンバーフィールドを持たせて追加後にそのオートナンバーで範囲を限定させる必要があります。

Comments

[Yoshikun_0945]

回答いただきましてありがとうございました。
この方法を実行してみます。

[sazi]

確認できてからクローズした方が良いですね。

[Yoshikun_0945]

上記のコードはどこかの行がSQL ＝ でしょうか？

[sazi]

VBAでSQLを記述したいという事ですか？

[Yoshikun_0945]

上記のコードだとSQL ＝ が必要でしょうか？

[Yoshikun_0945]

日付、社員番号、金額以外にオートナンバー型フィールドが必要という意味でよろしかったでしょうか？

[sazi]

最初に回答した部分はCSVに複数の日付データが含まれるという事なので、使えませんから、無視して下さい

[Yoshikun_0945]

私が記載したコードに追記する形で、日付の複製処理を行う場合はどのような処理になりますでしょうか？

[sazi]

オートナンバーを利用する為には、TransferTextを使用する場合はインポート定義が必要です。
また、オートナンバーは確実に順序が保証されるとは言い切れない（大丈夫でしょうが、保証はされていない）ですし、CSVを直接読み出す方法の方が良さそうな気がします。

[Yoshikun_0945]

ｃｓｖを直接読みだすとはどういう方法でしょうか？

[sazi]

「Open ステートメント」を使用するという事です。
https://docs.microsoft.com/ja-jp/office/vba/language/reference/user-interface-help/open-statement
http://officetanaka.net/excel/vba/file/file08.htm

[Yoshikun_0945]

ありがとうございました。

[sazi]

リンクテーブルで順読みの方が簡単かもしれません。
但し、order byは絶対に措定しないで。

Answer 2

Accessの場合(他のデータベースも同様ですが)、テーブルとして取り込んだ場合、入力順は保持されません。
次に開いたときに、どのような順になるかは不定です。

ですので、saziさんも指摘してるようにオートナンバー型のフィールドを持たせたテーブルにインポートして、オートナンバーで並べ替えて順次走査するか、
あるいは、csvをリンクテーブルにしておいて、それをVBAで順次読み込んで取り込みテーブルに順次追加していくという方法がいいでしょう。（リンクテーブルならテキストファイルを順次読み込みするので並び順はテキストと同じになる）

リンクテーブル案のコード例

• あくまで例ですのでそのままでは動作しません。
• ロジックを参考にしてください。
• 変数宣言、エラー処理は適宜追加してください。

 'テキストファイルをリンク
  DoCmd.TransferText acLinkDelim, , "LinkTbl" _
    , "C:\test\data.txt"

 'テキストファイルをリンク
    DoCmd.TransferText acLinkDelim, , "LinkTbl" _
        , "C:\test\data.txt"

    Set db = CurrentDb()
    'リンクテーブルを開く
    Set rs1 = db.OpenRecordset("LinkTbl;")
    '追加先テーブル
    Set rs2 = CurrentDb.OpenRecordset("DataTbl")


    '最後のレコードまで繰り返す
    Do Until rs1.EOF
        '日付がNullでなければ、変数に格納して次レコードへ
        If Not IsNull(rs1!日付.Value) Then
            varDate = rs1!日付.Value
            rs1.MoveNext
        End If
        '追加先テーブルに追加
        rs2.AddNew
        rs2!日付.Value = varDate
        rs2!社員番号.Value = rs1!社員番号.Value
        rs2!金額.Value = rs1!金額.Value
        rs2.Update

        '次のレコードに移動する
        rs1.MoveNext
    Loop

Comments

[sazi]

order byは外しておいた方が良いかと。

[hatena19]

そうでした。サンプルのを修正し忘れてました。