求助各位高手，为何这里的数据库脚本不能取到数据？

莫悠悠

Sub 筛选()
Dim R, C
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("明细账")
R = sh.Range("A65536").End(xlUp).Row
C = sh.[J1] '选车牌
If R > 2 Then sh.Range("A3:I" & R).Clear
On Error Resume Next
Dim CN As Object, Sql As String
Set CN = CreateObject("ADODB.Connection")
CN.Open "Provider = Microsoft.Jet.Oledb.4.0;Extended Properties =Excel 8.0;Data Source =" & ThisWorkbook.FullName
    Sql = "select r.日期,r.月份,r.单据编号,r.车牌号,r.大类,r.摘要,r.支出,r.经手人,r.备注 from [日记账$] r where r.车牌号=" & C & " order by r.日期"
    sh.Range("A3").CopyFromRecordset CN.Execute(Sql)
    CN.Close
    Set CN = Nothing
End Sub

两蛋一瓜

改为如下代码：

1. Sub 筛选()
   
2. Dim R, C
   
3. Dim sh As Worksheet
   
4. Set sh = ThisWorkbook.Sheets("明细账")
   
5. R = sh.Range("A65536").End(xlUp).Row
   
6. C = sh.[J1] '选车牌
   
7. If R > 2 Then sh.Range("A3:I" & R).Clear
   
8. On Error Resume Next
   
9. Dim CN As Object, Sql As String
   
10. Set CN = CreateObject("ADODB.Connection")
    
11. CN.Open "Provider = Microsoft.ACE.Oledb.12.0;Extended Properties =Excel 8.0;Data Source =" & ThisWorkbook.FullName
    
12.     Sql = "select * from [日记账$] where 车牌号= '" & C & "' order by 日期"
    
13.     sh.Range("A3").CopyFromRecordset CN.Execute(Sql)
    
14.     CN.Close
    
15.     Set CN = Nothing
    
16. End Sub

复制代码

莫悠悠

两蛋一瓜 发表于 2021-12-20 09:59
改为如下代码：

还是没有筛选到数据呢？

两蛋一瓜

莫悠悠 发表于 2021-12-20 16:19
还是没有筛选到数据呢？

附件中，日记账这个工作表首行删除，车牌号和日期要作为首行才行