• ベストアンサー

excelでのado接続での検索

シートのA列に商品コードが入っており、別ブックのA列に商品コード、B列に商品名が入っています。 現シートのA列を一行ずつ読んで、その商品コードをキーに別ブックの商品コードを検索し一致するコードがあれば現シートのB列に別ブックの商品名をセットする、という作業を勉強がてらado接続を使って実行したいと思い、下記のコードで実行してみました。 Dim CN As ADODB.Connection Dim RS As ADODB.Recordset Set CN = New ADODB.Connection CN.Provider = "Microsoft.Jet.OLEDB.4.0" CN.Properties("Extended Properties") = "Excel 8.0" CN.Open "C:\Users\*****\Desktop\shohinmaster.xls" For i = 2 To 最終行 Set RS = New ADODB.Recordset RS.Open "SELECT * FROM [shohin$] WHERE 商品コード = '" & Cells(i, 1) & "' ", CN If RS.EOF Then Cells(i, 2) = "???" Else Cells(i, 2) = 商品名 End If Next これで実行しますと、現シートの商品名は空白という結果になります。???とすらセットされませんでした。 また RS.Open の行の '" & Cells(i, 1) & "' という箇所なのですが、現シートの商品コードは数値で 入っているのですが、別シートの商品コードは文字列としてセットされていますのでこの形式にしております。 EXCELは2016、OSはWINDOWS7です。 どこが誤っているのかアドバイスいただければ幸いです。宜しくお願い致します。

質問者が選んだベストアンサー

  • ベストアンサー
  • ushi2015
  • ベストアンサー率51% (241/468)
回答No.1

こんにちは Set RS ~ はループの外でいいです。 商品コードが数値なら、Cells(i, 1)の前後のシングルコーテーションは不要です。 [shohin$]に別名(例えば「a」)をつけて、a.商品コード とします。 転記するフィールドはRS.Fields("商品名")のようにします。   Set RS = New ADODB.Recordset      For i = 2 To 最終行     RS.Open "SELECT * FROM [shohin$] AS a WHERE a.商品コード = " & Cells(i, 1) & " ", CN     If RS.EOF Then       Cells(i, 2) = "???"     Else       Cells(i, 2) = RS.Fields("商品名")     End If     RS.Close   Next とすると出来ますでしょうか?

takazou
質問者

お礼

早速試させていただきました。 提示していただいた形式で実行すると、”抽出条件でデータ型が一致しません"とエラーが出ました。 '" & Cells(i, 1) & "' ", CN と前後にシングルコーテーションを付けて実行させると商品名が表示されました。 質問で別ブックの商品コードが文字列としてセットされていますので、この形でよかったという事でしょうか。 いずれにしましても大変嬉しかったです。ASを使用する、RS.Fieldsという表現が勉強になりました。 本当にありがとうございました。

関連するQ&A

  • ADO ファイルを閉じるには?

    アクセスからエクセルへ Sub Sample() Dim cn As Object Dim rs As Object Set cn = CreateObject("ADODB.Connection") With cn .Provider = "Microsoft.ACE.OLEDB.12.0" .Properties("Extended Properties") = "Excel 12.0" .Properties("Data Source") = "D:\Book1.xlsx" .Open End With Set rs = CreateObject("ADODB.Recordset") rs.Open "SELECT * FROM [sheet1$]", cn, 3 Debug.Print rs.RecordCount rs.Close: cn.Close Set rs = Nothing : Set cn = Nothing End Sub このコードでシートの行数を取得してるのですが このコードを実行後もファイルが開いたままなのですが 閉じるにはどうすればいいのでしょうか? .Openでファイルが開くので cn.Close でファイルが閉じるのかと思ったら閉じません。 cn.Quitを追記してみましたが 実行時エラー -2147467259 選択クエリを実行できません。 となりました。 どうすればファイルを閉じることが出来るのでしょうか?

  • ExcelでADOを使って他のブックを参照したい

    いつも楽しく勉強させていただいております。 VBA関連のサイトを参照して同じブックにあるシートをADOを使って参照することに成功しました。 Dim CN As New ADODB.Connection Dim RS As New ADODB.Recordset Dim SQL As String Set CN = New ADODB.Connection CN.Provider = "Microsoft.Jet.OLEDB.4.0" CN.Properties("Extended Properties") = "Excel 8.0" CN.Open ThisWorkbook.FullName SQL = "SELECT * FROM [userlist$]" RS.Open SQL, CN, adOpenStatic, adLockReadOnly Do Until RS.EOF Debug.Print RS![P-1] RS.MoveNext Loop RS.Close CN.Close これを現在開いている別のブック、たとえばBook1にあるシートを参照するにはどこをどう書き換えたらいいでしょうか。

  • アクセスVBA。ADO

    CSVから列を分割してテーブルにしたいかったので 下記のコードを記述しましたが、 Dim cn As ADODB.Connection Dim rs As New ADODB.Recordset Dim datacount As Long Set cn = New ADODB.Connection With cn .ConnectionString = "Provider=Microsoft.jet.OLEDB.4.0;Data Source=" & CurrentProject.Path & "\;" .Properties("Extended Properties").Value = "text;HDR=YES;" .Open End With Set rs = cn.Execute("SELECT * FROM 構成マスタ.csv") datacount = rs.Fields.Count For i = 0 To datacount strsql = "SELECT " & rs.Fields(i).Name & " INTO " & rs.Fields(i).Name & " FROM 構成マスタ.csv;" cn.Execute strsql Next i rs.Close cn.Close Set rs = Nothing Set cn = Nothing SQLを実行するところで、「日付エラー」となってしまいます。 データには特に日付等はないのでエラーになる原因がわかりません。 どなたかご教示いただけますでしょうか。

  • ADOでエクセルに接続した後の文字検索方法について

    http://home.att.ne.jp/zeta/gen/excel/c04p42.htm こちらのページ下の方で■ADOレコードセットを取得して検索しますを 参考にさせて頂き、 検索.xlsを作成→VBAに下のように記述してtest.xlsのA列の中の文字列”excel”を検索して、 もしexcelという文字があれば該当セルの横のセルの文字を返すというものです、 この中で、test.xlsのA列を検索する部分の記述で RS.Find RS.Fields(0) & "='excel'" の部分でうまく行きません。 エラー内容としては 実行時エラー ’3001’: 引数が間違った型、許容範囲外、または競合しています。 と出てしまいます。 ためしにtest.xlsのA1セルにkoumokuと入力して RS.Find RS.Fields(0) & "='excel'"を 以下のように書き換るとうまく行きます RS.Find "koumoku='excel'" test.xlsには項目を作らずに今回は 項目指定ではなく列を指定して文字列を検索したいのですが どなたかお知恵を拝借させていただきたく存じます。 Public Sub test() Dim CN As ADODB.Connection Dim RS As ADODB.Recordset Dim SQL As String Set CN = New ADODB.Connection CN.Provider = "Microsoft.Jet.OLEDB.4.0" CN.Properties("Extended Properties") = "Excel 8.0" CN.Open "c:\test.xls" SQL = "SELECT * FROM [Sheet1$]" Set RS = New ADODB.Recordset RS.Open SQL, CN, adOpenStatic, adLockReadOnly 'RS.Find "koumoku='excel'" →これだとOK RS.Find RS.Fields(0) & "='excel'" If RS.EOF Then Debug.Print "Not Found" Else Debug.Print RS.Fields(1) TextBox1.Text = RS.Fields(1) End If End Sub

  • Access ADOについて質問です。

    Access ADOについて質問です。 以下コードでレコードセットを返す関数を使用しています。 動作的には問題ないのですが、標準モジュール内のレコードセットをClose及びNothingしていないのが気になります。 Private Sub Form_Open(Cancel As Integer) Dim rs2 As ADODB.Recordset Set rs2 = New ADODB.Recordset Set rs2 = CreateRecordSet("SELECT * FROM T_Standard;") Set Me.Recordset = rs2 rs2.Close: Set rs2 = Nothing end sub '標準モジュール Public Function CreateRecordSet(strSQL As String) As ADODB.Recordset Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection cn.ConnectionString = "provider=Microsoft.Jet.OLEDB.4.0;" _ & "Data Source=O:\標準DB\StandardBackEnd.mdb" cn.Open Set rs = New ADODB.Recordset rs.Open strSQL, cn, adOpenStatic, adLockReadOnly Set CreateRecordSet = rs ' rs.Close: Set rs = Nothing   ←この部分 ' cn.Close: Set cn = Nothing   ←この部分 End Function 標準モジュール内ではCloseやNothingしなくてもメモリの開放は行われているのでしょうか? アドバイスよろしくお願いいたします。

  • ADOを使用してExcelファイルをオープンし、内部結合したい。

    エクセルに2つのシートがあります。 シート名"男性用","女性用" それぞれのシートに"名前"の列があります。 この2つのシートを内部結合して検索したいのですが 可能でしょうか ----------------------シート1個の場合 Dim cn As ADODB.Connection Set cn = New ADODB.Connection cn.Provider = "Microsoft.Jet.OLEDB.4.0" cn.Properties("Extended Properties") = "Excel 8.0" cn.Properties("Data Source") = App.Path & "\test.xls" cn.Open Dim cmd As ADODB.Command Set rst = New ADODB.Recordset rst.Source = "Select * From [男性用$]" rst.ActiveConnection = cn rst.CursorType = adOpenDynamic rst.Open , , , , adCmdText '------------------------------ これで取り出せますがシート2つを内部結合させたいばあい rst.Source = "Select * From [男性用$]" はどう変えたらいいでしょうか excelでなければ select * from 男性用 inner join 女性用 on 男性用.名前=女性用.名前 となると思いますが。

  • ADOでエクセルからSQL Serverへデータを移行するには

    エクセルvbaのADOを使って、 SQL Serverの「test」という名のデータベースの「Table_1」に 新規レコードを追加する事はできますか? エクセルからアクセスには Sub test() Dim データベース名 As String Dim cn As ADODB.Connection Dim rs As ADODB.Recordset Set cn = New ADODB.Connection Set rs = New ADODB.Recordset cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & データベース名 rs.Open "Tテーブル1", cn, adOpenKeyset, adLockOptimistic rs.AddNew rs.Fields("フィールド1") = データ rs.Update rs.Close cn.Close Set rs = Nothing Set cn = Nothing End Sub で移行しています。 これをエクセルからSQL Serverへ移行させるにはどうすればいいのでしょうか? よろしくお願いします。

  • EXCELのVBAでのCSVファイル読込みと検索

    エクセルのマクロでCSVファイルを読み込み、その行の得意先サブコードをキー項目として別のCSVファイルを検索し電話番号とFAX番号を取得するという作業を下記のようなコードで作成しました。 Dim Obj As Object Dim Path As String Dim FName As String Dim i As Long Dim buf As String Dim tmp As Variant Dim WSH As Variant Dim CN As ADODB.Connection Dim RS As ADODB.Recordset '自分のPCのデスクトップをPathとして設定します。 Set WSH = CreateObject("Wscript.Shell") Path = WSH.SpecialFolders("Desktop") & "\" '得意先マスタ.csvをOPENする際の準備処理 '3行目のPropertiesがCSVファイルの定義(excelをOPENする時とは異なります) Set CN = New ADODB.Connection CN.Provider = "Microsoft.Jet.OLEDB.4.0" CN.Properties("Extended Properties") = "Text;HDR=YES;FMT=Delimited" CN.Open Path '得意先サブマスタ.CSVを開きます。 Open Path & "得意先サブマスタ.csv" For Input As #1 i = 1 Do Until EOF(1) Line Input #1, buf tmp = Split(buf, ",") If i = 1 Then Else Cells(j, 1).Value = Left(tmp(3), 4) '会社コード Cells(j, 2).Value = Right(tmp(3), 4) '店舗コード Cells(j, 3).Value = tmp(3) '会社@店舗 Cells(j, 4).Value = tmp(4) '得意先コード Cells(j, 5).Value = tmp(5) '店舗名 Set RS = New ADODB.Recordset RS.Open "SELECT * FROM 得意先マスタ.csv WHERE 得意先コード = " & tmp(4) & " ", CN If RS.EOF Then Cells(j, 6).Value = "???" Cells(j, 7).Value = "???" Else Cells(j, 6) = RS.Fields("電話番号") Cells(j, 7) = RS.Fields("FAX番号") End If End If i = i + 1 Loop このコードで動作確認すると途中で動作が止まってしまい応答なし状態になってしまいます。どこで止まるかは一定ではありません。CSVファイルの内容も確認したのですが、特におかしいような箇所はありませんでした。 OSはWINDOWS7、EXCELは2016です。 コード自体に修正した方がいいような箇所があればアドバイスいただきたいと思っております。宜しくお願い致します。

  • BeforeUpdateのADOの記述でエラー

    Access VBAです。 フォームの対象商品コードを入力後、他の項目にカーソルを移動すると 実行時エラー'91' オブジェクト変数またはWithブロック変数が設定されていません。 というメッセージが表示され、 rs.Open "商品T", cn, adOpenKeyset, adLockOptimistic, adCmdTableDirect が黄色くなります。 コーディングは、以下の通りです。 Option Compare Database Option Explicit Private cn As ADODB.Connection Private rs As ADODB.Recordset Private Sub Form_Load() 'フォームの読み込み時 Set cn = CurrentProject.Connection 'DB接続 End Sub Private Sub 対象商品コード_BeforeUpdate(Cancel As Integer) rs.Open "商品T", cn, adOpenKeyset, adLockOptimistic, adCmdTableDirect Set rs = New ADODB.Recordset rs.Index = "PrimaryKey" rs.Seek 対象商品コード, adSeekFirstEQ If rs.EOF Then MsgBox ("該当する商品は存在しませんでした。") Else 対象商品名.Caption = rs!商品名 End If End Sub

  • Excel ado処理について

    現在、Excel(インターフェース用)⇔(社内LAN経由)⇔Excel(マスターファイル×4)間で ADOを使用して、データ処理を行おうとしております。 (なお、今までは、画面更新OFFにしてファイルを素直にOPENして 各ファイルデータを格納して処理を行っていたのですが、 業務人員&量の拡大に伴い、Excelの競合が激しくなり、ADOによる処理へと 対応変更を考えております) マスターファイル×4はAccessのように、主キーが振ってあり、連結しております。 インターフェース用のExcelから各マスターファイルをADOで読み込み、 インターフェース用のExcelへとデータを転記する処理を作成中ですが、 なぜか、マスターファイル(A・B・C・D)のうち、Cのファイルのみ、データを10件ほど認識しておらず、 A=B=D≠Cとなってしまいます。 マスターファイルを直接開いて確認しますが、データ数は間違いなく一致しておりますが、 VBA上では認識しておりません。 自分なりに解析したところ、Cのファイルだけ、 "RS.MoveNext"の部分でデータが10件ほど飛んでいると思っております。 以下がそのソースですが、 どこが問題なのか?または、考えうる原因が他にあれば、ご教授いただきたいです。 本当に困っています。宜しくお願い致します。 --------------------------------------------------------------------- Sub StorageData() 'Frag初期値 SW_OK = True On Error GoTo ErrADO '取引先詳細 'ADO定型分 Set CN = New ADODB.Connection CN.Provider = "Microsoft.Jet.OLEDB.4.0" CN.Properties("Extended Properties") = "Excel 8.0" CN.Open Path00 & "反響データ\" & FileName01 Set RS = New ADODB.Recordset RS.Open SQL, CN, adOpenStatic, adLockReadOnly ReDim Data00(RS.RecordCount, 20) Ctr = 1 Do For i = 0 To 20 If Not RS.BOF Then Data00(Ctr, i) = RS.Fields(i) End If Next i i = 0 RS.MoveNext Ctr = Ctr + 1 Loop Until RS.EOF Ctr = Ctr - 1 ' ReDim Preserve Data00(Ctr, 20) Ctr = 0 Set RS = Nothing CN.Close 'お客さま詳細 'ADO定型分 Set CN = New ADODB.Connection CN.Provider = "Microsoft.Jet.OLEDB.4.0" CN.Properties("Extended Properties") = "Excel 8.0" CN.Open Path00 & "反響データ\" & FileNam

専門家に質問してみよう