如何用VBA查找增加和减少的名单

chxw68

1. Sub test3()
   
2. '  Dim cnn As New ADODB.Connection
   
3. '  Dim rs As New ADODB.Recordset
   
4.   Dim sql As String
   
5.   Dim mybook As String
   
6.   Dim cnn As Object
   
7.   Dim rs As Object
   
8.   Set cnn = CreateObject("adodb.connection")
   
9.   Set rs = CreateObject("adodb.recordset")
   
10.   mybook = ThisWorkbook.FullName
    
11.   With cnn
    
12.     If Application.Version = "11.0" Then
    
13.       .Provider = "microsoft.jet.oledb.4.0"
    
14.       .ConnectionString = "extended properties=""excel 8.0;HDR=YES;IMEX=1"";data source=" & mybook
    
15.     Else
    
16.       .Provider = "microsoft.ACE.oledb.12.0"
    
17.       .ConnectionString = "extended properties=""excel 12.0;HDR=YES;IMEX=1"";data source=" & mybook
    
18.     End If
    
19.     .Open
    
20.   End With
    
21.   sql = "select a.* from [上学期名单$a2:f] a where not isnull(学籍辅号) and a.学籍辅号 not in (select 学籍辅号 from [下学期名单$a2:a] where not isnull(学籍辅号))"
    
22.   rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
23.   With Worksheets("减少名单")
    
24.     .Cells.Delete
    
25.     For j = 0 To rs.Fields.Count - 1
    
26.       .Cells(1, j + 1) = rs.Fields(j).Name
    
27.     Next
    
28.     .Range("a2").CopyFromRecordset rs
    
29.   End With
    
30.   rs.Close
    
31.   sql = "select a.* from [下学期名单$a2:f] a where not isnull(学籍辅号) and a.学籍辅号 not in (select 学籍辅号 from [上学期名单$a2:a] where not isnull(学籍辅号))"
    
32.   rs.Open sql, cnn, adOpenKeyset, adLockOptimistic
    
33.   With Worksheets("增加名单")
    
34.     .Cells.Delete
    
35.     For j = 0 To rs.Fields.Count - 1
    
36.       .Cells(1, j + 1) = rs.Fields(j).Name
    
37.     Next
    
38.     .Range("a2").CopyFromRecordset rs
    
39.   End With
    
40. End Sub
    

复制代码

chxw68

增加了一个SQL法，SQL只要使用了where not in 速度就特别慢。

jiminyanyan

chxw68方法真多。。。

szqhb

chxw68 发表于 2018-7-14 21:53
两种解法。

很好，赞一个。