質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

新規登録して質問してみよう
ただいま回答率
86.12%
VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

受付中

VBAでシートからアクセスのテーブルにデータを追加したい。

Kazuhiro-ch
Kazuhiro-ch

総合スコア82

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。

1回答

0グッド

0クリップ

252閲覧

投稿2022/12/06 09:10

編集2022/12/07 05:19

前提

WorkSheet(wsStart)からAccessDB(test)に不足するデータを追加したい。
それぞれ日付データを取得して突合させ、データを挿入する。

お知らせ

以前の質問を踏襲して、質問しています。(内容は別)
https://teratail.com/questions/1ib3tvqtd06z80

詳細

Excel

日付数値1数値2数値3数値4
1/11000200010002000
1/21000200010002000
1/31000200010002000
1/41000200010002000

Access

日付数値1数値2数値3数値4
1/11000200010002000
1/21000200010002000

目的とするAccessDB

日付数値1数値2数値3数値4
1/11000200010002000
1/21000200010002000
1/31000200010002000
1/41000200010002000

データタイプはそれぞれ「日付/時刻型」と「数値型」です。

発生している問題・エラーメッセージ

error

1アプリケーション定義およびオブジェクト定義のエラーです。

該当のソースコード

vba

1 2Sub compare_and_copy_date() 3 4 Dim l As Long, lRow As Long 5 Dim wsStart As Worksheet: Set wsStart = ThisWorkbook.Sheets("start") 6 Dim myConn As New ADODB.Connection 7 myConn.Open ConnectionString:= _ 8 "Provider=Microsoft.ACE.OLEDB.12.0;" & _ 9 "Data Source=C:\Users\test.accdb" 10 Dim myRS As New ADODB.Recordset 11 myRS.Open Source:="test", ActiveConnection:=myConn, _ 12 CursorType:=adOpenDynamic 13 14 '行すべてを表示 15 wsStart.Rows.Hidden = False 16 17 'Excelを降順に 18 Range(Columns(1), Columns(5)).Sort Range("A1"), xlDescending 19 20 'Excelから[日付]列を取得 21 lRow = wsStart.Cells(Rows.Count, "A").End(xlUp).Row 22 23 'Excelデータの最新日付を取得 24 With myRS 25 For l = 2 To lRow 26 .MoveFirst 27 .Find "日付=#" & Format(wsStart.Cells(l, 1).Value, "yyyy/mm/dd") 'Excelから日付データの取得 28 If .EOF Then '一致する日付がなければ、行データ追加 29 .AddNew 30 !日付.Value = wsStart.Cells(l, 1) 31 !数値1.Value = wsStart.Cells(l, 2) 32 !数値2.Value = wsStart.Cells(l, 3) 33 !数値3.Value = wsStart.Cells(l, 4) 34 !数値4.Value = wsStart.Cells(l, 5) 35 .Update 36 End If 37 Next l 38 End With 39 40 myRS.Close: Set myRS = Nothing 41 myConn.Close: Set myConn = Nothing 42 43End Sub 44

試したこと

・.MoveNextなどで調整:インデックス(日付)などを取得していると考えたため。
・取得の確認:Debug.Printでエクセル上の日付データなどが取得できているか確認。
・文法の確認:もう一度見直しや意味があっているのか確認した。

N/A対応

vba

1If myRS.EOF Then '一致する日付がなければ、行データ追加 2 myRS.AddNew 3 If IsError(wsStart.Cells(l, 1)) Then 4 Exit For 5 Else 6 myRS!日付.Value = wsStart.Cells(l, 1) 7 End If 8 If IsError(wsStart.Cells(l, 2)) Then 9 Exit For 10 Else 11 myRS!始値.Value = wsStart.Cells(l, 6) 12 End If 13 myRS.Update 14Else 15 Exit For 16End If

以下のような質問にはグッドを送りましょう

  • 質問内容が明確
  • 自分も答えを知りたい
  • 質問者以外のユーザにも役立つ

グッドが多くついた質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

気になる質問をクリップする

クリップした質問は、後からいつでもマイページで確認できます。

またクリップした質問に回答があった際、通知やメールを受け取ることができます。

下記のような質問は推奨されていません。

  • 間違っている
  • 質問になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

適切な質問に修正を依頼しましょう。

回答1

0

質問のコードで、いくつか間違いがあったので修正しました。

修正箇所は2か所です。コメントの※の行です。

vba

1Sub compare_and_copy_date() 2 3 Dim l As Long, lRow As Long 4 Dim wsStart As Worksheet: Set wsStart = ThisWorkbook.Sheets("start") 5 Dim myConn As New ADODB.Connection 6 myConn.Open ConnectionString:= _ 7 "Provider=Microsoft.ACE.OLEDB.12.0;" & _ 8 "Data Source=C:\test\test.accdb" 9 Dim myRS As New ADODB.Recordset 10 myRS.Open Source:="test", ActiveConnection:=myConn, _ 11 CursorType:=adOpenDynamic, LockType:=adLockPessimistic '※LockTypeの設定が必要、省略するとReadOnlyになる 12 13 '行すべてを表示 14 wsStart.Rows.Hidden = False 15 16 'Excelを降順に 17 Range(Columns(1), Columns(5)).Sort Range("A1"), xlDescending 18 19 'Excelから[日付]列を取得 20 lRow = wsStart.Cells(Rows.Count, "A").End(xlUp).Row 21 22 'Excelデータの最新日付を取得 23 With myRS 24 For l = 2 To lRow 25 .MoveFirst 26 .Find "日付=#" & Format(wsStart.Cells(l, 1).Value, "yyyy/mm/dd") & "#" '※ 最後に # が必要 27 If .EOF Then '一致する日付がなければ、行データ追加 28 .AddNew 29 !日付.Value = wsStart.Cells(l, 1) 30 !数値1.Value = wsStart.Cells(l, 2) 31 !数値2.Value = wsStart.Cells(l, 3) 32 !数値3.Value = wsStart.Cells(l, 4) 33 !数値4.Value = wsStart.Cells(l, 5) 34 .Update 35 End If 36 Next l 37 End With 38 39 myRS.Close: Set myRS = Nothing 40 myConn.Close: Set myConn = Nothing 41 42End Sub

こちらで作成したサンプルでは、上記のコードで正常にAccessのテーブルにデータが追加されました。

追記 セルのn/aエラー対策

下記のように修正してください。

vba

1 If .EOF Then '一致する日付がなければ、行データ追加 2 .AddNew 3 If Not IsError(wsStart.Cells(l, 1)) Then !日付.Value = wsStart.Cells(l, 1) 4 If Not IsError(wsStart.Cells(l, 2)) Then !数値1.Value = wsStart.Cells(l, 2) 5 If Not IsError(wsStart.Cells(l, 3)) Then !数値2.Value = wsStart.Cells(l, 3) 6 If Not IsError(wsStart.Cells(l, 4)) Then !数値3.Value = wsStart.Cells(l, 4) 7 If Not IsError(wsStart.Cells(l, 5)) Then !数値4.Value = wsStart.Cells(l, 5) 8 .Update 9 End If

いちおうすべての項目にエラーチェックを付けましたが、式を設定してないセル(エラーになることははないセル)はなくてもいいです。

投稿2022/12/06 12:19

編集2022/12/08 03:58
hatena19

総合スコア32005

良いと思った回答にはグッドを送りましょう。
グッドが多くついた回答ほどページの上位に表示されるので、他の人が素晴らしい回答を見つけやすくなります。

下記のような回答は推奨されていません。

  • 間違っている回答
  • 質問の回答になっていない投稿
  • スパムや攻撃的な表現を用いた投稿

このような回答には修正を依頼しましょう。

回答へのコメント

Kazuhiro-ch

2022/12/07 05:21

ありがとうございます。試してみたところうまく動きました。 あと1点、N/Aなどのエラーがあったときに、そのセルはスキップして次に進むようにしたいです。 上記にコードを載せたのですが、動きません。(エラーは出ませんが、転記されない) どのようにするのが良いのでしょうか?ご教授いただけると幸いです。
hatena19

2022/12/08 01:33

> そのセルはスキップして次に進む とは具体的にどうしたいのでしょうか。 1.エラーセルと対応するフィールドは未入力にする。 2.エラーセルがあったらその行のデータは入力せずに、次の行に進む。 3.エラーセルがあったら、その時点で転記処理を終了する。 上記の3つのうちどれでしょう。 提示のコードだと Exit For してますので、3.の処理になってます。
Kazuhiro-ch

2022/12/08 02:48

1.エラーセルと対応するフィールドは未入力にする。です。 Exit Forはその時点で転記処理を終了する。という意味になってしまうのですね。知りませんでした。 現在のコードでは、エラーの有無に関わらず、転記されません。
Kazuhiro-ch

2022/12/08 04:34

ありがとうございます。 ただ、これだとエラーのところが0になってしまうようなのですが、それを回避する方法はありますか?
hatena19

2022/12/08 04:54

テーブルのフィールドの規定値プロパティが 0 になっているためだと思われます。これを削除してから試してください。
Kazuhiro-ch

2022/12/10 05:56

ありがとうございます。確かにそのようでした。 ちなみに幾つかのテーブルに流用する場合、都度テーブルごとに規定値を変更する必要がありますか? もしくはマクロで規定値をゼロにする→コードをうごかすなどできますか?
hatena19

2022/12/10 11:14

If IsError(wsStart.Cells(l, 1)) Then !日付.Value = Null Else !日付.Value = wsStart.Cells(l, 1) とすればいいでしょう。 本来はテーブル設計の段階でどうるすか決めておくべきことです。そうしないとNullと0が混在することになり、後でいろいろ面倒です。

まだベストアンサーが選ばれていません

会員登録して回答してみよう

アカウントをお持ちの方は

15分調べてもわからないことは
teratailで質問しよう!

ただいまの回答率
86.12%

質問をまとめることで
思考を整理して素早く解決

テンプレート機能で
簡単に質問をまとめる

質問する

関連した質問

同じタグがついた質問を見る

VBA

VBAはオブジェクト指向プログラミング言語のひとつで、マクロを作成によりExcelなどのOffice業務を自動化することができます。