Excel VBA質問箱 IV

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

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


3347 / 13646 ツリー ←次へ | 前へ→

【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のデータから必要なフィールドだけのデータを取得(方法はいろいろあり)
・追加(方法はいろいろあり)
それだけの話と思いますが。。。。

・1個しかrecordsetを追加してないけどそれで良いんですか?
・変数fldが変化してないと思う。
長い間DAO触ってないので自信ないですが、
・myRst(fld).Nameってエラー出ませんか?
コンパイルはエラーなしで出来ますか?

【62779】Re:ExcelからAccessへデータ受け渡し
発言  どらちゃん  - 09/9/1(火) 6:13 -

引用なし
パスワード
   ▼neptune さん:

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

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


>
>・Excelのデータから必要なフィールドだけのデータを取得(方法はいろいろあり)
>・追加(方法はいろいろあり)
>それだけの話と思いますが。。。。
>
>・1個しか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するようにしたいのです。
前にも書きましたけど、AddNew1回では1レコードのみの追加ですが。
これで良いんですか?複数のデータは該当しないのですか?

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 さん:
>前にも書きましたけど、AddNew1回では1レコードのみの追加ですが。
>これで良いんですか?複数のデータは該当しないのですか?

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


>
>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行目の17列からがタイトル行ですね。
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するようにしました。

みなさま、ありがとうございました。
今後ともよろしくお願いします。

3347 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free