标题: 问:用VBA代码删除多笔重复记录的疑惑 [打印本页] 作者: fnsmydyang 时间: 2010-7-22 20:49 标题: 问:用VBA代码删除多笔重复记录的疑惑 删除多笔重复记录,只保留一笔记录,我分别写了三段代码,但只有二段代码可行,不明其理,上来问问各位。。。
两个Recodset对象全部用DAO ‘行不通,无法删除,但程序可正常运行
Public Sub AA()
Dim I As Integer
Dim N As Integer
Dim m As DAO.Recordset
Dim RS As DAO.Recordset
Set RS = CurrentDb.OpenRecordset("唯一")
Do Until RS.EOF
Set m = CurrentDb.OpenRecordset("SELECT * FROM 物料表 where 物料编码='" & RS("物料编码") & "'")
If m.RecordCount > 1 Then
For I = 1 To m.RecordCount - 1
m.Delete
N = N + 1
m.MoveNext
Next
End If
RS.MoveNext
Loop
MsgBox "共删除" & N & "笔重复记录"
End Sub
两个Recodset对象分别用DAO/ADO
Public Sub BB() '可以正常删除,程序可正常运行
Dim I As Integer
Dim N As Integer
Dim m As ADODB.Recordset
Set m = New ADODB.Recordset
Dim RS As DAO.Recordset
Set RS = CurrentDb.OpenRecordset("唯一")
Do Until RS.EOF
m.Open "SELECT * FROM 物料表 where 物料编码='" & RS("物料编码") & "'", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If m.RecordCount > 1 Then
For I = 1 To m.RecordCount - 1
m.Delete
N = N + 1
m.MoveNext
Next
End If
m.Close
RS.MoveNext
Loop
MsgBox "共删除" & N & "笔重复记录"
End Sub
两个Recodset对象全部用ADO
Public Sub CC() '可以正常删除,程序可正常运行
Dim I As Integer
Dim N As Integer
Dim m As ADODB.Recordset
Set m = New ADODB.Recordset
Dim RS As ADODB.Recordset
Set RS = New ADODB.Recordset
RS.Open "SELECT DISTINCT 物料编码 FROM 物料表", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
Do Until RS.EOF
m.Open "SELECT * FROM 物料表 where 物料编码='" & RS("物料编码") & "'", CurrentProject.Connection, adOpenKeyset, adLockOptimistic
If m.RecordCount > 1 Then
For I = 1 To m.RecordCount - 1
m.Delete
N = N + 1
m.MoveNext
Next
End If
m.Close
RS.MoveNext
Loop
MsgBox "共删除" & N & "笔重复记录"
End Sub 作者: 红尘如烟 时间: 2010-7-22 22:51
更简单的办法: 打开一个对【物料编码】字段排序的记录集,然后循环记录,如果当前物料编码等于前一条记录的物料编码则删除之
Dim rst As DAO.Recordset
Dim strTemp As String
Set rst=CurrentDb.OpenRecordset("SELECT * FROM 物料表 ORDER BY 物料编码")
If rst.RecordCount>0 Then
rst.MoveFirst
strTemp=rst!物料编码
rst.MoveNext
Do Until rst.EOF
If rst!物料编码=strTemp Then
rst.Delete
Else
strTemp=rst!物料编码
End If
rst.MoveNext
Loop
End If
rst.Close
Set rst=Nothing
复制代码
作者: fnsmydyang 时间: 2010-7-23 06:22
谢谢红尘老大的指点,受益良多......作者: ycxchen 时间: 2010-7-23 08:37
两个Recodset对象全部用DAO ‘行不通,无法删除,但程序可正常运行
Public Sub AA()
Dim I As Integer
Dim N As Integer
Dim m As DAO.Recordset
Dim RS As DAO.Recordset
Set RS = CurrentDb.OpenRecordset("唯一")
Do Until RS.EOF
Set m = CurrentDb.OpenRecordset("SELECT * FROM 物料表 where 物料编码='" & RS("物料编码") & "'")
If m.RecordCount > 1 Then
For I = 1 To m.RecordCount - 1
m.Delete
N = N + 1
m.MoveNext
Next
End If
RS.MoveNext
Loop
MsgBox "共删除" & N & "笔重复记录"
End Sub
我也想知道上面代码错在什么地方作者: yihesmxx 时间: 2010-7-23 09:57
学习学习