那位大能帮我看看我这个查询代码的问题，谢谢

ctrl_119

附件是一个办公用品出入库的表格，其中输入单号后单击查询，有时候可以查询成功，有时候又查不成查询代码如下：

Sub xinjian()

Range("c6:h11").Value = ""
Range("j6:j11").Value = ""
Range("d3,f3,j3,d14,f14,j14").Value = ""
Application.ScreenUpdating = True
MsgBox "请重新选择单据类型"
End Sub
Sub chaxun()
Dim hm, cel As Range
If Range("j3").Value = "" Then
       MsgBox "请输入需要查询的单据号码"
       Exit Sub
  End If
Range("c6:h11").Value = ""
Range("j6:j11").Value = ""
Range("d3,f3,d14,f14,j14").Value = ""
  hm = Range("j3").Value
    If hm = 0 Then Exit Sub
     For Each cel In Sheet6.Range("d2:d" & Sheet6.[d65536].End(xlUp).Row)
       If cel.Value = hm Then
         Range("b2") = cel.Offset(0, -3).Value
         Range("d3") = cel.Offset(0, -2).Value
         Range("f3") = cel.Offset(0, -1).Value
         Range("d14") = cel.Offset(0, 12).Value
         Range("j14") = cel.Offset(0, 15).Value
          If Range("b2") = "入库单" Then
           Range("e14") = "采购员"
           Range("f14") = cel.Offset(0, 13).Value
          Else
           Range("e14") = "领用人"
           Range("f14") = cel.Offset(0, 14).Value
          End If
       End If

    Next
  Set x = CreateObject("adodb.connection")
    x.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName

     If Range("b2") = "入库单" Then
         Range("c6").CopyFromRecordset x.Execute("select 编码,物品名称,规格型号,单位,入库数量,入库单价 from [数据库$] WHERE 单据号码 =" & hm & "")
       Else
         Range("c6").CopyFromRecordset x.Execute("select 编码,物品名称,规格型号,单位,出库数量,出库单价 from [数据库$] WHERE 单据号码 =" & hm & "")
     End If

     Range("j6").CopyFromRecordset x.Execute("select 备注 from [数据库$] WHERE 单据号码 =" & hm & "")

  x.Close
  Set x = Nothing

End Sub

wanao2008

细看了一下，表格里的错误很多，例如：
1，无论你选择“入库单”还是“出库单”，当点击“查询”按钮后，B2单元格都变成“出库单”
2，就算不能查出所要的表格内容，也会填上一些信息，比如，领用部门，日期，库管等
3，在出库单号处（即J3单元格）输入“入库单号”，如“1”，会查出内容，但表头确是“出库单”
就不一一举例了。
这个程序的作者水平远远高出我。他用数据库的方式查询数据，我不会:-(

ctrl_119

谢谢你的关注，这个代码我也是在论坛上找到的，修改了一下在使用。
只有物品列表中的数据是查询了有问题··
领用部门，日期，库管的查询用的是没有问题的
查询前是不需要选蛇表单类型的，表名是和查询表单对应的，查询单号1对应的是入库单，表名就显示入库单，查询单号5007607对应的是出库单，表名就显示出库单

蓝桥玄霜

凡是WHERE 单据号码 =" & hm & "")  都改为：WHERE 单据号码 ='" & hm & "'")
因为号码是文本格式，所以在变量两边需要加单引号'；
数据库的单据号码列前面的数据不是文本，需要改为文本格式，要有一个绿色的小方块显示。

ctrl_119

蓝桥玄霜 发表于 2020-2-4 11:44
凡是WHERE 单据号码 =" & hm & "")  都改为：WHERE 单据号码 ='" & hm & "'")
因为号码是文本格式，所以在 ...

老师您好
按照你的提示修改代码可是出现错误提示

之后又修改回去后，把数据库表中的单号格式按照您的提示做了修改。现在是入库单数据可以完全查出来，可是出库单就查询不完整

请问这是什么原因呀···查询代码都是一样的···唯一的区别就是出库单查询源不是连续的列。是这个原因吗？刚刚试了一下调整列的位置，好像出库单的查询好像也不行。

grf1973

既然已经遍历判断出入库了，那么干脆一次遍历解决所有问题，不再用sql。

1. Sub chaxun()
   
2. Dim hm, cel As Range
   
3. Sheets(1).Activate
   
4. If Range("j3").Value = "" Then
   
5.        MsgBox "请输入需要查询的单据号码"
   
6.        Exit Sub
   
7.   End If
   
8. Range("c6:j11").Value = ""
   
9.   Range("d3,f3,d14,f14,j14").Value = ""
   
10.   hm = CStr(Range("j3").Value)
    
11. arr = Sheets("数据库").[a1].CurrentRegion
    
12. Dim brr(1 To 6, 1 To 8)
    
13. For i = 2 To UBound(arr)
    
14.     If CStr(arr(i, 4)) = hm Then
    
15.         n = n + 1
    
16.         brr(n, 1) = arr(i, 5)
    
17.         brr(n, 2) = arr(i, 6)
    
18.         brr(n, 3) = arr(i, 7)
    
19.         brr(n, 4) = arr(i, 8)
    
20.         brr(n, 5) = arr(i, 9) + arr(i, 12)
    
21.         brr(n, 6) = arr(i, 10) + arr(i, 13)
    
22.         brr(n, 7) = arr(i, 11) + arr(i, 14)
    
23.         brr(n, 8) = arr(i, 15)
    
24.         crk = arr(i, 1)
    
25.         bm = arr(i, 2)
    
26.         rq = arr(i, 3)
    
27.         kg = arr(i, 16)
    
28.         sh = arr(i, 19)
    
29.         ry = arr(i, 17) & arr(i, 18)
    
30.        End If
    
31.      
    
32.     Next
    
33.     If n > 6 Then MsgBox "超出显示范围": Exit Sub
    
34.     If n > 0 Then
    
35.         Range("b2") = crk  '出入库
    
36.          Range("d3") = bm             '部门cel.Offset(0, -2).Value
    
37.          Range("f3") = rq             '日期cel.Offset(0, -1).Value
    
38.          Range("d14") = kg               '库管cel.Offset(0, 12).Value
    
39.          Range("j14") = sh        '审核   cel.Offset(0, 15).Value
    
40.          Range("e14") = IIf(crk = "入库单", "采购员", "领用人")
    
41.          Range("f14") = ry      '采购员 & 领用人  cel.Offset(0, 14).Value
    
42.         [c6].Resize(n, 8) = brr
    
43.     End If
    
44.   End Sub

复制代码

grf1973

另外显示 区域只有6行，超过范围怎么办。

ctrl_119

grf1973 发表于 2020-2-4 14:49
另外显示 区域只有6行，超过范围怎么办。

输入的时候就只能输入6行，所以查询的是否最多就只会有6行的。