SQL跨工作簿匹配待修改

APPLE123

这是论坛老师写的代码，但是我结合工作实际，将本表下移2行，将数据源表下移1行，代码就无法正常运行，提示：运行错误-2147217904.......至少一个参数没有被指定值

点击调试显示：Range("G2").CopyFromRecordset Cn.Execute(Sq(0))为黄色

请教老师，该如何修改代码才能获取正确的结果。

正在学习SQL写法，如有注释更好，谢谢！

fzxba

Sub test()
  Dim f$
  'f = ThisWorkbook.Path & Application.PathSeparator & "1.xlsx"   '指定工作簿
  With Application.FileDialog(msoFileDialogOpen)                 '选择工作簿
    .InitialFileName = ThisWorkbook.Path
    With .Filters
      .Clear
      .Add "Excel文件(xls*)", "*.xls*"
    End With
    .AllowMultiSelect = False
    If .Show Then f = .SelectedItems(1) Else Exit Sub
  End With
  Dim Conn As Object, SQL$
  Set Conn = CreateObject("ADODB.Connection")
  Conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
  SQL = "[" & ActiveSheet.Name & "$F3:F" & Cells(Rows.Count, "F").End(xlUp).Row & "]"
  SQL = "SELECT a.商品编号,b.商品名称,b.商品规格,b.生产企业,b.批准文号 FROM " & SQL & " a LEFT JOIN [Excel 12.0;Database=" & f & "].[$A2:H] b ON a.商品编号=b.商品编号"
  Range("F4").CopyFromRecordset Conn.Execute(SQL)
  Conn.Close: Set Conn = Nothing
  MsgBox " ok!", 64
End Sub

sdytsxd991122

limonet

代码在审核

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("adodb.connection")
    Cn.Open "provider=microsoft.ace.oledb.12.0;extended properties=excel 12.0;data source=" & ThisWorkbook.Path & "\2.xlsx"
    StrSQL = "select a.商品名称,a.商品规格,a.生产企业,a.批准文号 from [Sheet1$A2:H]a INNeR JOIN [excel 12.0;database=" & ThisWorkbook.FullName & "].[Sheet1$A3:j]b on b.商品编号=a.商品编号"
    Range("G4").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

limonet

其实吧，用index+match也可以，没必要非得VBA+SQL。

APPLE123

sdytsxd991122 发表于 2022-12-16 14:07

谢谢老师的帮助！

再帮我看看这个，麻烦老师了！谢谢

sdytsxd991122

APPLE123 发表于 2022-12-16 14:30
谢谢老师的帮助！

再帮我看看这个，麻烦老师了！谢谢

APPLE123

sdytsxd991122 发表于 2022-12-16 15:00

谢谢老师的帮助！好好学习一下！

APPLE123

limonet 发表于 2022-12-16 14:24
代码在审核

谢谢老师指点