求大神用VBA出手

jie520

求大神用VBA出手写代码，查询表条件年  月   姓名三条件引用数据库数据过来

xiangbaoan

……………………

iwangyi

Sub cc()
Set cn = CreateObject("adodb.connection")
cn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source= " & ThisWorkbook.FullName
Sql = "SELECT * FROM [数据库$a2:k] where year(日期)=" & Cells(2, 1) & " and month(日期)=" & Cells(2, 3) & " and 姓名='" & Cells(3, 2) & "'"
Range("a5").CopyFromRecordset cn.Execute(Sql)
End Sub

jie520

xiangbaoan 发表于 2018-9-14 13:53
……………………

非常感谢！

jie520

xiangbaoan 发表于 2018-9-14 13:53
……………………

再次感谢了，但发觉多引入了“”姓名“”列。上面已经查询了姓名又多个姓名列不对吧。如果不要“姓名”列如何？

lsc900707

jie520 发表于 2018-9-14 22:01
再次感谢了，但发觉多引入了“”姓名“”列。上面已经查询了姓名又多个姓名列不对吧。如果不要“姓名”列 ...

1. Sub gj23w98()
   
2.     Dim crr(1 To 999, 1 To 8)
   
3.     Application.ScreenUpdating = False
   
4.     arr = Sheet1.[a1].CurrentRegion
   
5.     brr = Range("a1:c3")
   
6.     For i = 3 To UBound(arr)
   
7.         If Year(arr(i, 2)) & Month(arr(i, 2)) & arr(i, 3) = brr(2, 1) & brr(2, 3) & brr(3, 2) Then
   
8.             m = m + 1
   
9.             crr(m, 1) = arr(i, 1)
   
10.             crr(m, 2) = arr(i, 2)
    
11.             For j = 3 To 8
    
12.                 crr(m, j) = arr(i, j + 1)
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     If m Then
    
17.         Range("a5:h" & Rows.Count).ClearContents
    
18.         [a5].Resize(m, 8) = crr
    
19.     Else
    
20.         MsgBox "没有符合条件的数据哦，请查证！"
    
21.     End If
    
22.     Application.ScreenUpdating = True
    
23. End Sub
    

复制代码

lsc900707

jie520 发表于 2018-9-14 22:01
再次感谢了，但发觉多引入了“”姓名“”列。上面已经查询了姓名又多个姓名列不对吧。如果不要“姓名”列 ...

附件供测试：

xiangbaoan

jie520 发表于 2018-9-14 22:01
再次感谢了，但发觉多引入了“”姓名“”列。上面已经查询了姓名又多个姓名列不对吧。如果不要“姓名”列 ...

'吹毛求疵，找到粗的，在前面加上。
If c <> 3 Then ar(k, c) = br(r, c)