| |
以前こちらで教えていただいたコードを応用して、別のプログラムを作らなければいけなくなりました。
契約者名 支店名 担当者名
ＮＥＣ
富士通
東芝
日立
上のようなエクセルシートがあって、担当者リストから、担当者と支店名を貼り付けていくのですが、担当者リストの方の契約者名には、例えば、ＮＥＣ株式会社とか株式会社富士通などというように正式な名称が入っています。あいまい検索によって、貼り付ける方法をどなたか教えてください。よろしくお願いいたします。
以下のようなコードではエラーは出ませんが、検索が上手く行っていないようで、データを貼り付けてくれませんでした。
Sub TEST1()
Dim SQLCode As String
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim dbName As String
Dim Kiten As range
Dim Cnt As Long
Dim k As Long
Set Kiten = range("b1")
Set cnn = New ADODB.Connection
cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" _
& "Data Source=C:\Documents and Settings\週報.mdb"
cnn.Open
Set rst = New ADODB.Recordset
For Cnt = Kiten.row To Kiten.End(xlDown).row
SQLCode = "SELECT 担当リスト.* " _
& "FROM 担当リスト " _
& "WHERE 契約者名 like '*" & Cells(Cnt, 1) & "*';"
rst.Open SQLCode, cnn
i = 3
Do Until rst.EOF
For j = 0 To 1
Cells(Cnt, i) = rst.Fields(j)
i = i + 1
Next j
rst.MoveNext
Loop
rst.Close
Next
Set rst = Nothing
cnn.Close
Set cnn = Nothing
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
