Excel VBA質問箱 IV

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

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


2877 / 13644 ツリー ←次へ | 前へ→

【65468】Accessから値を取得するには? kokoa 10/5/24(月) 17:15 質問[未読]
【65470】Re:Accessから値を取得するには? ponpon 10/5/24(月) 18:05 発言[未読]
【65471】Re:Accessから値を取得するには? kokoa 10/5/24(月) 18:33 質問[未読]
【65472】Re:Accessから値を取得するには? ponpon 10/5/24(月) 19:10 発言[未読]
【65477】Re:Accessから値を取得するには? ichinose 10/5/25(火) 6:58 発言[未読]
【65490】Re:Accessから値を取得するには? Yuki 10/5/26(水) 11:01 発言[未読]

【65468】Accessから値を取得するには?
質問  kokoa  - 10/5/24(月) 17:15 -

引用なし
パスワード
   いつも拝見させて頂いてます

Accessの配達者一覧のテーブルから
すでに入力されているEXCEL側の配達者に対して地域を入力させたいのですが
可能ですか?


配達者一覧(Access側)
地域|配達者
大阪|太郎
京都|次郎
東京|三郎


配達記録(EXCEL側)
地域名|日々配達者
   |三郎
   |次郎

【65470】Re:Accessから値を取得するには?
発言  ponpon  - 10/5/24(月) 18:05 -

引用なし
パスワード
   ▼kokoa さん:
参考になれば

h tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=65454;id=excel

【65471】Re:Accessから値を取得するには?
質問  kokoa  - 10/5/24(月) 18:33 -

引用なし
パスワード
   ▼ponpon さん:
>▼kokoa さん:
>参考になれば
>
>h tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=65454;id=excel

返事有難うございます

ADOで接続しSQLで絞込み等はできるのですが
貼り付け後VLOOKUPするのもどうかと思ってます

【65472】Re:Accessから値を取得するには?
発言  ponpon  - 10/5/24(月) 19:10 -

引用なし
パスワード
   ▼kokoa さん:
>返事有難うございます
>
>ADOで接続しSQLで絞込み等はできるのですが
>貼り付け後VLOOKUPするのもどうかと思ってます

なるほど。そちらでしたか?
別シートに貼り付けVLOOKUPする、または、一致したとなりを貼り付ける
以外に思いつきません。

識者の回答をお待ちください。

ちなみに、私は,エクセルに落としてからデータを加工していました。
力になれず、申し訳ありません。

【65477】Re:Accessから値を取得するには?
発言  ichinose  - 10/5/25(火) 6:58 -

引用なし
パスワード
   おはようございます。

>貼り付け後VLOOKUPするのもどうかと思ってます
ADOのFindメソッドを使ってみました。

>配達者一覧(Access側)
>地域|配達者
>大阪|太郎
>京都|次郎
>東京|三郎

このテーブルがsample1.mdbというmdbファイルにあるとして・・・。
(テーブル名やフィールド名も上記のとおりだとして)

Excel側は、新規ブックにて

標準モジュール(Module1)に

'=====================================================
Sub mk_sample()
  With ActiveSheet
    .Range("a1:b5").Clear
    .Range("a1:b1").Value = Array("地域名", "日々配達者")
    .Range("b2:b5").Value = [{"三郎";"次郎";"一郎";"太郎"}]
  End With
End Sub

上記mk_sampleを実行してみてください。
アクティブシートにサンプルデータが作成されます。
作成されたデータに対して、地域名を設定するVBAを考えます。


実際のコードです。

別の標準モジュール(Module2)にADO I/Oプロシジャー群

'================================================================
Private cn As Object
Function open_db(dbpath As String) As Long
  On Error GoTo err_open_db
  open_db = 0
  foldnm = ThisWorkbook.Path & "\"
  Set cn = CreateObject("ADODB.Connection")
  cn.ConnectionString = "provider=Microsoft.jet.OLEDB.4.0;" & "Data Source=" & dbpath
  cn.Open
  On Error GoTo 0
  Exit Function
err_open_db:
  MsgBox Error(Err.Number) & Err.Number
  open_db = Err.Number
End Function
'================================================================
Sub close_db()
  On Error Resume Next
  cn.Close
  Set cn = Nothing
  On Error GoTo 0
End Sub
'================================================================
Function execute_sql(sql As String, grs As Object) As Long
  On Error GoTo err_sql
  close_rs grs
  execute_sql = 0
  grs.Open sql, cn, adOpenStatic, adLockPessimistic
ret_err_sql:
  On Error GoTo 0
  Exit Function
err_sql:
  MsgBox Error(Err.Number) & Err.Number
  execute_sql = Err.Number
  Resume ret_err_sql
End Function
'================================================================
Sub close_rs(grs As Object)
  On Error Resume Next
  grs.Close
End Sub


別の標準モジュール(Module3)に、サンプルデータを加工するコード

'===========================================================
Sub test()
  Dim rs As Object
  Dim rng As Range
  Dim crng As Range
  With ActiveSheet
    Set rng = .Range("b2", .Cells(.Rows.Count, "b").End(xlUp))
  End With
  If rng.Row > 1 Then
    Set rs = CreateObject("adodb.recordset")
    If open_db(ThisWorkbook.Path & "\sample1.mdb") = 0 Then
     If execute_sql("配達者一覧", rs) = 0 Then
       rng.Offset(0, -1).ClearContents
       For Each crng In rng
        rs.Find "配達者 = '" & crng.Text & "'", , adSearchForward, 1
        If rs.EOF <> True Then
          crng.Offset(0, -1).Value = rs!地域
        End If
       Next
       Call close_rs(rs)
     End If
     Call close_db
    End If
    Set rs = Nothing
  End If
  Set rng = Nothing
  Set crng = Nothing
End Sub


testを実行してみてください。
   A     B
1 地域名  日々配達者
2 東京    三郎
3 京都    次郎
4       一郎
5 大阪    太郎


こんな結果になりました。
試してみてください。

【65490】Re:Accessから値を取得するには?
発言  Yuki  - 10/5/26(水) 11:01 -

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

>Accessの配達者一覧のテーブルから
>すでに入力されているEXCEL側の配達者に対して地域を入力させたいのですが
>可能ですか?
もう、解決されていると思いますが
こんな感じで出来ます。
Option Explicit
Sub MdbXlsSet()
  Dim strMdb As String
  Dim strXls As String
  Dim strSQL As String
  Dim cn   As ADODB.Connection
  Dim rs   As ADODB.Recordset

  strXls = ThisWorkbook.FullName
  strMdb = "D:\AccessAPP\db21.mdb"

  strSQL = "SELECT T1.[地域], T2.[日々配達者] " & _
       "FROM 配達者一覧 AS T1 RIGHT JOIN (SELECT * FROM [配達記録$] IN '" & strXls & "' " & _
       "'Excel 8.0;HDR=YES') AS T2 ON T1.[配達者] = T2.[日々配達者]"

'配達者一覧 (Access側)
'地域|配達者
'大阪|太郎
'京都|次郎
'東京|三郎
'
'
'配達記録 (EXCEL側)
'地域名|日々配達者
'   |三郎
'   |次郎

  Set cn = New ADODB.Connection
  With cn
    .Provider = "Microsoft.Jet.OLEDB.4.0"
    .ConnectionString = "Data Source=" & strMdb
    .Open
  End With
  
  Set rs = New ADODB.Recordset
  With rs
    .ActiveConnection = cn
    .CursorLocation = adUseClient
    .CursorType = adOpenStatic
    .LockType = adLockOptimistic
    .Source = strSQL
    .Open Options:=adCmdText
  End With
  
  With Worksheets("配達記録")
    .Cells.Resize(.Rows.Count - 1).Offset(1).Clear
    .Range("A2").CopyFromRecordset rs
  End With
  rs.Close
  cn.Close
  Set rs = Nothing
  Set cn = Nothing
End Sub

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