[已解决]查询问题

jds

谢谢老师，帮忙修改下    “修改成入库的C列，在C列任何一单元格输入编码调取数据库内容”
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Count > 1 Then Exit Sub
If Target.Address <> "$C$1" And Target.Address <> "$D$1" Then Exit Sub   
Dim Myr&, Arr, i&, n&
Myr = Sheet2.[c65536].End(xlUp).Row
Arr = Sheet2.Range("c8:K" & Myr): n = 3: m = 3

Range("a4:k1000").Clear
For i = 1 To UBound(Arr)
    If Target.Address = "$C$1" Then
        If Arr(i, 1) >= Target.Value And Arr(i, 1) <= Target.Offset(0, 1).Value Then
            m = m + 1
            Cells(m, 3) = Arr(i, 1)
            Cells(m, 2) = Arr(i, 2)
            Cells(m, 4) = Arr(i, 3)
            Cells(m, 6) = Arr(i, 8)
            Cells(m, 7) = Arr(i, 6)
        End If
    Else
        End If
Next
Cells(4, 1).Resize(m - 3, 11).Borders.LineStyle = 1
End Sub

最佳答案

月排行榜 / 总排行榜

fjmxwrs

2016-11-5 18:29

对应的哪些内容，你的入库表和数据库表中的项目不同呀，如果代码中对应的不对，你自己改一下对应的列即可

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim myr%, myc%, arr, mybh
   
3.     myr = Target.Row
   
4.     myc = Target.Column
   
5.     If myr > 3 And myc = 3 Then
   
6.         arr = Sheet1.UsedRange
   
7.         mybh = Target.Value
   
8.         For x = 8 To UBound(arr)
   
9.             If arr(x, 3) = mybh Then
   
10.                 Application.EnableEvents = False
    
11.                 Cells(myr, 2) = arr(x, 4)
    
12.                 Cells(myr, 4) = arr(x, 1)
    
13.                 Cells(myr, 5) = arr(x, 28)
    
14.                 Cells(myr, 6) = arr(x, 10)
    
15.                 Cells(myr, 7) = arr(x, 8)
    
16.                 Application.EnableEvents = True
    
17.                 Exit Sub
    
18.             End If
    
19.         Next x
    
20.         MsgBox "没有找到该编码！"
    
21.     End If
    
22. End Sub
    

复制代码

跳转到最佳答案楼层

苏子龙

b列输入=VLOOKUP($C4,数据库!C:AC,2,0),其他的红色数值，3，26，8？数据源没有写清楚，我猜的是那些，还可以用index+match组合查找

jds

苏子龙 发表于 2016-11-5 13:47
b列输入=VLOOKUP($C4,数据库!C:AC,2,0),其他的红色数值，3，26，8？数据源没有写清楚，我猜的是那些，还可 ...

谢谢您关注，我忘记说明了，我想要代码调取

fjmxwrs

对应的哪些内容，你的入库表和数据库表中的项目不同呀，如果代码中对应的不对，你自己改一下对应的列即可

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim myr%, myc%, arr, mybh
   
3.     myr = Target.Row
   
4.     myc = Target.Column
   
5.     If myr > 3 And myc = 3 Then
   
6.         arr = Sheet1.UsedRange
   
7.         mybh = Target.Value
   
8.         For x = 8 To UBound(arr)
   
9.             If arr(x, 3) = mybh Then
   
10.                 Application.EnableEvents = False
    
11.                 Cells(myr, 2) = arr(x, 4)
    
12.                 Cells(myr, 4) = arr(x, 1)
    
13.                 Cells(myr, 5) = arr(x, 28)
    
14.                 Cells(myr, 6) = arr(x, 10)
    
15.                 Cells(myr, 7) = arr(x, 8)
    
16.                 Application.EnableEvents = True
    
17.                 Exit Sub
    
18.             End If
    
19.         Next x
    
20.         MsgBox "没有找到该编码！"
    
21.     End If
    
22. End Sub
    

复制代码

jds

感谢fjmxwrs老师，谢谢您的帮助