根据日期更新其他工作薄数据

zhaogang1960

请测试附件
帮助.rar (32 KB, 下载次数: 11)

2013-12-6 21:29 上传

点击文件名下载附件

chyidc

zhaogang1960 发表于 2013-12-6 21:28
请测试：

代码运行后，数据是按要求过来了，但好像有错误提示

代码中提示


还麻烦老师再看下

chyidc

zhaogang1960 发表于 2013-12-6 21:29
请测试附件

OK了，非常感谢赵老师的无私帮助
学到了不少东西，消化下，有问题再来请教老师

chyidc

zhaogang1960 发表于 2013-12-6 21:29
请测试附件

对了，老师，如果想统计出rs里面复制过来的记录总数怎么办？
msgbox s里面怎么体现出来呢？

zhaogang1960

chyidc 发表于 2013-12-6 23:54
对了，老师，如果想统计出rs里面复制过来的记录总数怎么办？
msgbox s里面怎么体现出来呢？

1. Sub Getdate()
   
2.     Dim cnn As Object, rs As Object, SQL As String
   
3.     Set cnn = CreateObject("adodb.connection")
   
4.     Set rs = CreateObject("adodb.recordset")
   
5.     cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.Path & "\text1.xlsx"
   
6.     SQL = "select " & Join([a1:h1&""], ",") & " from [Sheet1$] where 日期>#" & Range("a" & Rows.Count).End(xlUp) & "#"
   
7.     rs.Open SQL, cnn, 1, 3
   
8.     If rs.RecordCount > 0 Then
   
9.         s = "共更新记录" & rs.RecordCount & "条，分别是："
   
10.         SQL = "select 日期,count(*) from  [Sheet1$] where 日期>#" & Range("a" & Rows.Count).End(xlUp) & "# group by 日期"
    
11.         Range("a" & Rows.Count).End(xlUp).Offset(1).CopyFromRecordset rs
    
12.         Set rs = CreateObject("adodb.recordset")
    
13.         rs.Open SQL, cnn, 1, 3
    
14.         For i = 1 To rs.RecordCount
    
15.             s = s & vbCrLf & rs.Fields(0).Value & "更新" & rs.Fields(1).Value & "条"
    
16.             rs.MoveNext
    
17.         Next
    
18.         MsgBox s
    
19.     End If
    
20.     rs.Close
    
21.     cnn.Close
    
22.     Set rs = Nothing
    
23.     Set cnn = Nothing
    
24. End Sub
    

复制代码

zhaogang1960

请看附件
帮助.rar (32.07 KB, 下载次数: 10)

2013-12-7 00:36 上传

点击文件名下载附件

chyidc

zhaogang1960 发表于 2013-12-7 00:36
请看附件

感谢赵老师的热心帮助！！！

LMY123

SQL = "select " & Join([a1:h1&""], ",") & " from [Sheet1$] where 日期>#" & Range("a" & Rows.Count).End(xlUp) & "#"