Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3345 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【62775】ExcelからAccessへデータ受け渡し どらちゃん 09/8/31(月) 19:58 質問[未読]
【62776】Re:ExcelからAccessへデータ受け渡し neptune 09/8/31(月) 23:02 発言[未読]
【62779】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/1(火) 6:13 発言[未読]
【62780】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/1(火) 12:34 質問[未読]
【62781】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/1(火) 13:59 発言[未読]
【62783】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/1(火) 15:30 質問[未読]
【62784】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/1(火) 15:44 発言[未読]
【62793】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/2(水) 7:20 発言[未読]
【62795】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/2(水) 20:30 質問[未読]
【62799】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/3(木) 8:52 発言[未読]
【62800】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/3(木) 10:01 質問[未読]
【62801】Re:ExcelからAccessへデータ受け渡し Yuki 09/9/3(木) 12:23 発言[未読]
【62804】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/3(木) 19:21 お礼[未読]
【62782】Re:ExcelからAccessへデータ受け渡し neptune 09/9/1(火) 14:42 発言[未読]
【62786】Re:ExcelからAccessへデータ受け渡し どらちゃん 09/9/1(火) 21:00 発言[未読]
【62789】Re:ExcelからAccessへデータ受け渡し neptune 09/9/1(火) 22:18 発言[未読]
【62775】ExcelからAccessへデータ受け渡し
質問  どらちゃん  - 09/8/31(月) 19:58 -
引用なし
パスワード
   お世話になります。

時系列で並んでいるExcelのデータのうち、ある一日のデータのみをアクセスへEXPORTしたいのですが、EXCELの項目名とAccessのフィールド名が同じものだけEXPORTするようにしたいのです。deleteまではスムーズですが、その後のどこをどういう風に直したらいいかわからなくなってしまいました。
教えていただけませんでしょうか。

＜EXCEL＞
　　　　　　B　　　C　　　E
2009/8/1　さんま　あじ　いわし

↓

＜Access＞
　　　　　　A　　　B　　　C　　　D　　　E
2009/8/1　　　　さんま　あじ　　　　　いわし

-------------

Dim CBk As Workbook
Dim CSht As Worksheet
Dim Cr As Byte: Dim Col As Byte

Public Sub Port_Export()
　　Dim myDb As DAO.Database
　　Dim myRst As DAO.Recordset
　　Dim myFileName As String:　　 Dim myTblsql As String:　　 Dim myTbl As String
　　Dim dt As Date
　　Dim fld As Long

　　Set CBk = ThisWorkbook: Set CSht = CBk.ActiveSheet
　　dt = CSht.Cells(2, 1).Value
　　　
　　Select Case CBk.ActiveSheet.Name
　　　　Case "Pr":　myTbl = "Daily"
　　　　Case "Bg":　myTbl = "Ind"
　　End Select
　
　　myFileName = "test.mdb"
　　myTblsql = "delete * FROM " & myTbl & " WHERE " & myTbl & ".date in(#" & dt & "#)"
　　
　　Set myDb = OpenDatabase(CBk.Path & "\" & myFileName)
　　myDb.Execute myTblsql
　　
　　Set myRst = myDb.OpenRecordset(myTbl, dbOpenDynaset)
　　Cr = 8: Col = 17
　　myRst.AddNew
　　ct = 17
　　Do Until CSht.Cells(Cr, 17) = ""
　　　　If CSht.Cells(Cr, 17) = dt Then
　　　　　　Do Until CSht.Cells(Cr, Col) = ""
　　　　　　　　For fld = 0 To myRst.Fields.Count - 1
　　　　　　　　　　If myRst(fld).Name = CSht.Cells(7, ct) Then
　　　　　　　　　　With myRst
　　　　　　　　　　　　.Fields(fld) = CSht.Cells(Cr, Col)
　　　　　　　　　　　　.Update
　　　　　　　　　　End With
　　　　　　　　　　ct = ct + 1
　　　　　　　　　　End If
　　　　　　　　Next
　　　　　　Loop
　　　　End If
　　　　Cr = Cr + 1
　　Loop
　　　
　　myDb.Close
　　Set myRst = Nothing
　　Set myDb = Nothing
End Sub
【62776】Re:ExcelからAccessへデータ受け渡し
発言  neptune  - 09/8/31(月) 23:02 -
引用なし
パスワード
   ▼どらちゃん さん：
>お世話になります。
>
>時系列で並んでいるExcelのデータのうち、ある一日のデータのみをアクセス
>へEXPORTしたいのですが、EXCELの項目名とAccessのフィールド名が同じもの
>だけEXPORTするようにしたいのです。deleteまではスムーズですが、その後の
>どこをどういう風に直したらいいかわからなくなってしまいました。
>教えていただけませんでしょうか。
しばらく眺めてみましたが、説明と処理の関係がわからんようになりました。
どれくらいのデータ量があるのか、Excelにフィールド名がキチンとあるのかなど
判りませんが
exportとdeleteの関係が良くわからんです。

・Excelのデータから必要なフィールドだけのデータを取得（方法はいろいろあり）
・追加（方法はいろいろあり）
それだけの話と思いますが。。。。

・１個しかrecordsetを追加してないけどそれで良いんですか？
・変数fldが変化してないと思う。
長い間DAO触ってないので自信ないですが、
・myRst(fld).Nameってエラー出ませんか？
コンパイルはエラーなしで出来ますか？
【62779】Re:ExcelからAccessへデータ受け渡し
発言  どらちゃん  - 09/9/1(火) 6:13 -
引用なし
パスワード
   ▼neptune さん：

>どれくらいのデータ量があるのか、Excelにフィールド名がキチンとあるのかなど
>判りませんが
>exportとdeleteの関係が良くわからんです。

excelにフィールド名はあります。
deleteは、EXPORTを一度したあとで再度修正上書きするときのために入れてます。


>
>・Excelのデータから必要なフィールドだけのデータを取得（方法はいろいろあり）
>・追加（方法はいろいろあり）
>それだけの話と思いますが。。。。
>
>・１個しかrecordsetを追加してないけどそれで良いんですか？
>・変数fldが変化してないと思う。
変数が変化してないですか。よくわかってないので。。

>長い間DAO触ってないので自信ないですが、
>・myRst(fld).Nameってエラー出ませんか？
>コンパイルはエラーなしで出来ますか？

ありがとうございます、もう一度みてみます。
【62780】Re:ExcelからAccessへデータ受け渡し
質問  どらちゃん  - 09/9/1(火) 12:34 -
引用なし
パスワード
   一部修正をしてデータがエクスポートされるようになりました。
が、If myRst(fld).Name = CSht.Cells(7, Col) Thenで一番最初に日付をExportするのですが、そのupdateのときわけのかわらない数字が一気に入ってきてしまいます。といっても、たぶんこの説明だとなんのことやらというかんじだとおもいますが。。。


-----------
'当該日付セル位置ゲット
　　Cr = 8
　　Do Until CSht.Cells(Cr, 17) = ""
　　　　If CSht.Cells(Cr, 17) = dt Then
　　　　　　Ct = Cr
　　　　　　Exit Do
　　　　Else
　　　　　　Cr = Cr + 1
　　　　End If
　　Loop
　　'EXPORT
　　Set myRst = myDb.OpenRecordset(myTbl, dbOpenDynaset)
　　myRst.AddNew
　　For Col = 17 To 31
　　　　For fld = 0 To myRst.Fields.Count - 1
　　　　　　If myRst(fld).Name = CSht.Cells(7, Col) Then
　　　　　　With myRst
　　　　　　　　.Edit
　　　　　　　　.Fields(fld).Value = CSht.Cells(Ct, Col)
　　　　　　　　.Update
　　　　　　End With
　　　　　　End If
　　　　Next
　　Next
　　'CLOSE
　　myDb.Close
　　Set myRst = Nothing
　　Set myDb = Nothing
【62781】Re:ExcelからAccessへデータ受け渡し
発言  Yuki  - 09/9/1(火) 13:59 -
引用なし
パスワード
   ▼どらちゃん さん：
>が、If myRst(fld).Name = CSht.Cells(7, Col) Thenで一番最初に日付をExportするのですが、そのupdateのときわけのかわらない数字が一気に入ってきてしまいます。といっても、たぶんこの説明だとなんのことやらというかんじだとおもいますが。。。

アクセスの受け取り側のフィールドのタイプは何でしょう。
多分　訳の分からない数値とは日付のシリアル値だと思います。

>　　　　　　If myRst(fld).Name = CSht.Cells(7, Col) Then
>　　　　　　With myRst
>　　　　　　　　.Edit
>　　　　　　　　.Fields(fld).Value = CSht.Cells(Ct, Col)
　　　　　　　　 .Fields(fld).Value = Format(CSht.Cells(Ct, Col).value, "yyyy/mm/dd")
　　　　　　　　 とかにされたらどうでしょう。日付タイプの時だけですよ。

方法は違いますが
SQLでINSERT INTO で追加クエリを発行してインポートする方法もあります。　
【62782】Re:ExcelからAccessへデータ受け渡し
発言  neptune  - 09/9/1(火) 14:42 -
引用なし
パスワード
   ▼どらちゃん さん：
>時系列で並んでいるExcelのデータのうち、ある一日のデータのみをアクセスへEXPORTしたいのですが、
>EXCELの項目名とAccessのフィールド名が同じものだけEXPORTするようにしたいのです。
前にも書きましたけど、AddNew１回では１レコードのみの追加ですが。
これで良いんですか？複数のデータは該当しないのですか？

fldは相変わらずデータを入れている様でもないし。fld = 0 という事。
なんの為の変数かわけが判りません。

>deleteは、EXPORTを一度したあとで再度修正上書きするときのために入れてます。
とありますが、deleteはexportする前に行っていますけど。
また、deleteは削除ですから修正上書きとは性格が違います。

>一部修正をしてデータがエクスポートされるようになりました。
>が、If myRst(fld).Name = CSht.Cells(7, Col) Thenで一番最初に日付をExportするのですが、
>そのupdateのときわけのかわらない数字が一気に入ってきてしまいます。
申し訳ないですが、細かな手法は置いといて、理解力がないせいか、
想像力不足の為か全体像が良く掴めません。全体がわからなければこの部分だけ
正常にしても無意味と思います。

なので有益なことを書けそうも無いです。
accessのそのフィールドのデータ型が日付型ならそのまんまでも良いし。
文字列型なら文字列を整形してやらなければならないし。
【62783】Re:ExcelからAccessへデータ受け渡し
質問  どらちゃん  - 09/9/1(火) 15:30 -
引用なし
パスワード
   ▼Yuki さん：
>
>アクセスの受け取り側のフィールドのタイプは何でしょう。
>多分　訳の分からない数値とは日付のシリアル値だと思います。
これは日付型でうまくいっています。

>
>>　　　　　　If myRst(fld).Name = CSht.Cells(7, Col) Then
>>　　　　　　With myRst
>>　　　　　　　　.Edit
>>　　　　　　　　.Fields(fld).Value = CSht.Cells(Ct, Col)
>　　　　　　　　 .Fields(fld).Value = Format(CSht.Cells(Ct, Col).value, "yyyy/mm/dd")
>　　　　　　　　 とかにされたらどうでしょう。日付タイプの時だけですよ。
>
>方法は違いますが
>SQLでINSERT INTO で追加クエリを発行してインポートする方法もあります。　


今現在フィールドの数が違っていて、今後双方に増えたり減ったりしても対応してくれるように書けたらいいなと思い、フィールド名の一致したものだけ、受け渡すように書きたかったんです。それってSQLで出来るんですかね？

いづれにしても、説明もうまくないために、ご迷惑をかけているので、もっとEXCELのデータをシンプルな状態にしてから出来る範囲でExportしたほうがよさそうですね。すみません。。
ありがとうございます
【62784】Re:ExcelからAccessへデータ受け渡し
発言  Yuki  - 09/9/1(火) 15:44 -
引用なし
パスワード
   ▼どらちゃん さん：

>今現在フィールドの数が違っていて、今後双方に増えたり減ったりしても対応し
>てくれるように書けたらいいなと思い、フィールド名の一致したものだけ、受け
>渡すように書きたかったんです。それってSQLで出来るんですかね？

SQLで出来ますよ。
今日は時間がないですから
明日の朝にでもサンプルをUPしますね。
【62786】Re:ExcelからAccessへデータ受け渡し
発言  どらちゃん  - 09/9/1(火) 21:00 -
引用なし
パスワード
   ▼neptune さん：
>前にも書きましたけど、AddNew１回では１レコードのみの追加ですが。
>これで良いんですか？複数のデータは該当しないのですか？

レコードは１レコードなのです。


>
>fldは相変わらずデータを入れている様でもないし。fld = 0 という事。
>なんの為の変数かわけが判りません。

fldは変数になっているのですが。。。過去の投稿からみつけて書きました。
fieldがなくなるまでカウントされるようになってます。

>
>>deleteは、EXPORTを一度したあとで再度修正上書きするときのために入れてます。
>とありますが、deleteはexportする前に行っていますけど。
>また、deleteは削除ですから修正上書きとは性格が違います。

これは、EXCELで数字を修正後、再度マクロをまわすときのためのものです。

説明が下手ですみませんでした。
自分でもいろいろやってみます。
【62789】Re:ExcelからAccessへデータ受け渡し
発言  neptune  - 09/9/1(火) 22:18 -
引用なし
パスワード
   ▼どらちゃん さん：
>fldは変数になっているのですが。。。過去の投稿からみつけて書きました。
>fieldがなくなるまでカウントされるようになってます。
ごめんなさい。見逃していたようです。counterで使ってますね。

ちょっと見直してみます。
【62793】Re:ExcelからAccessへデータ受け渡し
発言  Yuki  - 09/9/2(水) 7:20 -
引用なし
パスワード
   ▼どらちゃん さん：

こんにちは。
サンプルをUPしますね。
7行目の１７列からがタイトル行ですね。
MDBのパスとExcelのパスは変えてくださいね。

Sub TestInsert見本1()
　　Dim strMdb　As String
　　Dim strTBL　As String
　　Dim wb　　　As Workbook
　　Dim strDir　As String
　　Dim strSnm　As String
　　Dim strFnm　As String
　　Dim strSQL　As String
　　Dim strSQL1 As String
　　Dim strSQL2 As String
　　Dim i　　　 As Long
　　Dim j　　　 As Long
　　Dim fldN()　As String
　　Dim flg　　 As Boolean
　　Dim sRow　　As Long
　　Dim eRow　　As Long
　　Dim sCol　　As Long
　　Dim eCol　　As Long
　　Dim strCol　As String
　　
　　Dim myDb　　As DAO.Database
　　Dim tblDf　 As DAO.TableDef
　　Dim fld　　 As Object
　　Dim Dic　　 As Scripting.Dictionary
　　
　　strMdb = "D:\Access\Test.mdb"　　　　　 ' Access
　　strTBL = "T_INTESTa"　　　　　　　　　　' Access
　　
　　strDir = "D:\Excel\Test\"　　　　　　　 ' Excel
　　strSnm = strDir & "Sample.xls"　　　　　' Excel
　　strFnm = Dir(strSnm)
　　
　　Set myDb = OpenDatabase(strMdb)
　　Set Dic = CreateObject("Scripting.Dictionary")
　　
　　Set tblDf = myDb.TableDefs("T_INTESTa")
　　For Each fld In tblDf.Fields
　　　　' AccessのTableのフィールド名登録
　　　　Dic(Trim(fld.Name)) = Empty
　　Next
　　
' ************************* フィールド名の為 ***************************
　　On Error Resume Next
　　Set wb = Workbooks(strFnm)
　　On Error GoTo 0
　　If wb Is Nothing Then
　　　　Set wb = Workbooks.Open(strSnm)
　　　　flg = True
　　End If
　　
　　' フィールド名のセット
　　sRow = 7　　' 7行目はHeaderがあるとして　　　　　　　　　　 ' Start行
　　sCol = 17　 ' 17列目Start列
　　j = -1
　　With wb.Worksheets(1)
　　　　eCol = .Cells(17, .Columns.Count).End(xlToLeft).Column　' 最終列
　　　　strCol = Split(.Cells(1, eCol).Address, "$")(1)　　　　 ' 列文字
　　　　eRow = .Range("Q" & .Rows.Count).End(xlUp).Row　　　　　' 最終行
　　　　For i = sCol To eCol
　　　　　　If Dic.Exists(Trim(.Cells(7, i))) Then
　　　　　　　　' Excel と Access のフィールド名が同じ物を登録
　　　　　　　　j = j + 1
　　　　　　　　ReDim Preserve fldN(j)
　　　　　　　　fldN(j) = Trim(.Cells(7, i))
　　　　　　End If
　　　　Next
　　End With
　　
　　If flg Then wb.Close False
　　If j = -1 Then GoTo Proc_Close　' 合致するフィールド名が無かった時
　　
　　For i = 0 To UBound(fldN)
　　　　' フィールド名の整形
　　　　strSQL1 = strSQL1 & fldN(i) & ", "
　　　　strSQL2 = strSQL2 & "T." & fldN(i) & ", "
　　Next
　　strSQL1 = Left(strSQL1, Len(strSQL1) - 2)
　　strSQL2 = Left(strSQL2, Len(strSQL2) - 2)
' ************************************************************************
　　' SQL文の結合
　　strSQL = "INSERT INTO [" & strTBL & "] " & _
　　　　　　　　"(" & strSQL1 & ") " & _
　　　　　　 "SELECT " & strSQL2 & " " & _
　　　　　　 "FROM [Sheet1$Q" & sRow & ":" & strCol & eRow & "] AS T " & _
　　　　　　　　"IN '" & strDir & strFnm & "' " & _
　　　　　　　　　　 "'Excel 8.0;HDR=YES'"
　　' SQL文はDebug.Printで確認して下さい。
　　' 実行
　　myDb.Execute strSQL
Proc_Close:
　　myDb.Close
　　Set myDb = Nothing
End Sub
【62795】Re:ExcelからAccessへデータ受け渡し
質問  どらちゃん  - 09/9/2(水) 20:30 -
引用なし
パスワード
   Yukiさん

どうもありがとうございます。
地道にフィールド名をつかんでそれから、という具合なのですね。勉強になります。

いいかんじでいくのですが、最後のINSERT INTOステートメントの構文エラーになります。フィールド名の部分等には問題がないようにみえるのですが。
申し訳ありませんが、SQL文を見てもらっていいですか。


INSERT INTO [Daily] (Date, TP, QQ, MP, MS, S, MD, EE, EH, SV, GE, BF, F20, BB, EJ) SELECT T.Date, T.TP, T.QQ, T.MP, T.MS, T.S, T.MD, T.EE, T.EH, T.SV, T.GE, T.BF, T.F20, T.BB, T.EJ FROM [Sheet1$a1:O2] AS T IN 'P:\month\test\test.xls' 'Excel 8.0;HDR=YES'
【62799】Re:ExcelからAccessへデータ受け渡し
発言  Yuki  - 09/9/3(木) 8:52 -
引用なし
パスワード
   ▼どらちゃん さん：

>INSERT INTO [Daily] (Date, TP, QQ, MP, MS, S, MD, EE, EH, SV, GE, BF, F20, BB, EJ) SELECT T.Date, T.TP, T.QQ, T.MP, T.MS, T.S, T.MD, T.EE, T.EH, T.SV, T.GE, T.BF, T.F20, T.BB, T.EJ FROM [Sheet1$a1:O2] AS T IN 'P:\month\test\test.xls' 'Excel 8.0;HDR=YES'

アクセス側のフィールド名を[]で括ってあげれば宜しいと思います。
INSERT INTO [Daily] ([Date], [TP], [QQ], [MP], [MS], [S], ・・・

　　For i = 0 To UBound(fldN)
　　　　' フィールド名の整形
　　　　strSQL1 = strSQL1 & "[" & fldN(i) & "], "　'<=に変更して下さい。
　　　　strSQL2 = strSQL2 & "T." & fldN(i) & ", "
　　Next
【62800】Re:ExcelからAccessへデータ受け渡し
質問  どらちゃん  - 09/9/3(木) 10:01 -
引用なし
パスワード
   パラメータが少なすぎます。2を指定してください。

というエラーが出てしまいます。
すみません、どうしたらいいのか教えてもらえますか
【62801】Re:ExcelからAccessへデータ受け渡し
発言  Yuki  - 09/9/3(木) 12:23 -
引用なし
パスワード
   ▼どらちゃん さん：
>パラメータが少なすぎます。2を指定してください。
>
>というエラーが出てしまいます。

多分
T.BB, T.EJ FROM [Sheet1$a1:O2] AS T IN 'P:\month\test\test.xls' 'Excel 8.0;HDR=YES'
の[Sheet1$a1:O2]の部分て合っていますか。
シート名が違ったりしていませんか。

今の場合だと
　　strSQL = "INSERT INTO [Daily] " & _
　　　　　　 "SELECT * " & _
　　　　　　 "FROM [Sheet1$] " & _
　　　　　　　　"IN 'P:\month\test\test.xls' 'Excel 8.0;HDR=YES'
でもいけますね。
一度試してみて下さい。
【62804】Re:ExcelからAccessへデータ受け渡し
お礼  どらちゃん  - 09/9/3(木) 19:21 -
引用なし
パスワード
   ▼Yuki さん：
>
>今の場合だと
>　　strSQL = "INSERT INTO [Daily] " & _
>　　　　　　 "SELECT * " & _
>　　　　　　 "FROM [Sheet1$] " & _
>　　　　　　　　"IN 'P:\month\test\test.xls' 'Excel 8.0;HDR=YES'
>でもいけますね。
>一度試してみて下さい。


どうもありがとうございました。
無事完成しました。

結局、フィールドをSELECTするINSERT INTOをやめ、EXCEL上でシートをいったん移して、上記のようなシンプルなSQL文にしました。
遠回りでしたがその分いろいろなことが分かり今後に役立ちそうです。

また、INSERT INTO文だけだと上書きに対応できないので、該当日付のレコードが既にある場合には一度DELETEするようにしました。

みなさま、ありがとうございました。
今後ともよろしくお願いします。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3345 / 13644 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free