Ejecutar Recordset se vuelve lento

Tengo este codigo que compara 2 tablas diferentes

Tbl_ComprasDet compara con apartadosCOtiCompra

Compara si el codigo es igual y tiene una cantidad que lo agrege ala tabla

Tbl_ComprasDet

Lo hace pero se tarda mucho en mas de 50 registro

No se si algui me puede ayudar para que la consult sea mas rapida

Dim numeroA As String
numeroA = Me.Codigo.Value
'Otra forma es usar un Recordset directo a la tablas
Dim rs As DAO.Recordset 'Creamos el recordset dao
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Tbl_ComprasDet WHERE NrPedidoDet = " & numeroA, dbOpenDynaset)
Me.Refresh 'Refrescamos la vista
rs.MoveFirst 'Nos movemos al inicio
Do While Not rs.EOF 'Verificamos que no hemos llegado al final
rs.Edit 'Editamos los registros
rs!Qtdeapar = Nz(DCount("Catapartado", "apartadosCOtiCompra", "[Nopieza]='" & rs!CodProducto & "'"), 0)
rs.Update 'Actualizamos
rs.MoveNext 'Nos movemos al siguiente registro
Loop 'Hacemos el bucle de nuevo
rs.Close 'Cerramos la variable
Set rs = Nothing 'Dejamos la variable sin inicializar
Me. Refresh 'Refrescamos la vista