如果是我设计程序，我不会打开价格表。
另外我喜欢设计价格查询窗体或是列表来处理这样的问题？请老师指点！
前面发的附件有个小问题，不能识别小写输入；现更正后上传
C17:Happym8888
D组学委:windimi007前来叫作业！
这次正好借用兰版的这个题练习一下在VBA中使用SQL，有什么不当之处还望兰版指导，谢谢。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address(0, 0) = "E5" Then
Dim AdoConn As Object
Dim AdoRst As Object
Dim StrConn As String
Dim StrSql As String
Dim arr
Set AdoConn = CreateObject("Adodb.connection")
Set AdoRst = CreateObject("Adodb.RecordSet")
StrConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES"";"""
StrSql = "SELECT 单价 FROM . WHERE STRCOMP(产品名称,""" & Target.Value & """,0)=0"
AdoConn.Open StrConn
Set AdoRst = AdoConn.Execute(StrSql)
arr = AdoRst.GetRows
If Err.Number = 3021 Then
Cells(7, "E") = "查找不到"
Else
If UBound(arr, 2) = 0 Then
Cells(7, "E") = arr(0, 0)
Else
Cells(7, "E") = Join(Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Transpose(arr)), ",")
End If
End If
AdoRst.Close
AdoConn.Close
Set AdoRst = Nothing
Set AdoConn = Nothing
End If
End Sub
上交作业，祥见附件
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim jgb As Workbook
If Sh.Name = "Sheet1" And Target.Address = "$E$5" Then
Set jgb = Workbooks.Open(ThisWorkbook.Path & "价格表.xls")
Dim x As Integer
Dim m
For x = 2 To 7
If Target.Value = Cells(x, 1) Then
m = Cells(x, 2)
Target.Offset(2, 0).Value = m
MsgBox (m)
Exit For
Else
Target.Offset(2, 0).Value = "查找不到"
End If
Next x
jgb.Close
End If
结果虽然出来了感觉效果不是很好，还望老师指点指点
本帖最后由 byhdch 于 2012-3-5 18:14 编辑
交下作业，第八课第9讲{:1_1:}
C组10： CHRISSHA