ADODB - Range.Delete dans une boucle de RecordSet désynchronise le RecordSet

Bonjour à tous,

Je vais tenté d'être plus explicite.

Je dois détruire les lignes Excel qui sont sélectionnées dans un recordset clone. Imaginons que j'ai trois lignes sélectionnées via SQL dans un recordSet et que l'un des champs correspond à un incrément (dans mon exemple colonne 4 nommé Nr) donc unique.

Je boucle sur mon recordset et pour chaque incrément de mon enregistrement courant, je recherche dans la colonne 4 la valeur ayant celle du recordSet!Nr et je détruis la ligne dans l'onglet. J'ai donc le code suivant:

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24

'--- With string variables sSql = "SELECT now(), Nr " & _ " FROM mononglet AS A " & _ " WHERE True" & _ " AND [Responsable] = 'Toto'"     '--- Run the SQL SELECT oRSetActive.Open sSql, goADODBCnx, adOpenKeyset If oRSetActive.EOF Then oRSetActive.Close: GoTo Exit_ Set oRSetClone = oRSetActive.Clone 'oRSetActive.Close   'oShtArchive.Cells(lLastRowArchive + 1, 1).CopyFromRecordset oRSetClone   Debug.Print oRSetClone.RecordCount oRSetClone.MoveFirst Do While Not oRSetClone.EOF Debug.Print oRSetClone.RecordCount & " - " & oRSetClone![Nr] lRowDel = oShtActive.Columns(4).Find(oRSetClone![Nr]).Row oShtActive.Rows(lRowDel).EntireRow.Delete   oRSetClone.MoveNext '------------------> Au 1er MoveNext, ça positionne le curseur sur le 3ième enregistrement et cela est dû à .Delete Loop

---

Citation:

---

oRSetClone.MoveNext

---

Au 1er MoveNext, positionne le curseur sur le 3ième enregistrement et cela est dû à Entire.Delete car si mets en commentaire EntireRow.Delete alors à la première itération du MoveNext, le curseur se positionne bien sur le 2ième enregistrement

Une explication?

Bonjour,
Ne t'étonnes pas de te casser la gueule si tu scie la branche ou tu est assis!

Si tu supprime une ligne de ton tableau Excel tu affectes ton recordset!

Code:

---

1 2 3 4

T=oRSetClone.getrows For i= 0 to Ubound(t) lRowDel = oShtActive.Columns(4).Find(t(i,1)).Row Next

---

Il faut effectivement passer par

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Dim vRSet As Variant Dim lIdx as long   vRSet = oRSetActive.GetRows oRSetActive.Close   For m lIdx = 0 To UBound(vRSet, 2) '--> Car 2 dimensions: 1ière = La colonne, 2ième = Les valeurs de la colonne et c'est la taille de la seconde qu'il faut connaitre! Attention index commence à 0 Debug.Print vRSet(4, lIdx) lRowDel = oShtActive.Columns(4).Find(vRSet(4, lIdx)).Row oShtActive.Rows(lRowDel).EntireRow.Delete Next

---

Ou et c'est ma préférence

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Dim arrRSet() As Long Dm lIdx as long   oRSetActive.MoveFirst lIdx = 0 Do While Not oRSetActive.EOF ReDim Preserve arrRSet(lIdx) arrRSet(lIdx) = oRSetActive.Fields("Nr") lIdx = lIdx + 1 oRSetActive.MoveNext Loop

---

Bonjour,

informer, juste une remarque de pinailleur de ma part :)

Code:

---

Do While Not

---

peut s'écrire

Code:

---

Do Until

---

Bonjour tototiti2008

Il y a une différence assez importante entre Do While ... Loop et Do Until ..... Loop :
Avec Do While, on teste avant toute exécution des instructions (donc éventuellement 0 fois dans certains cas) , alors qu'avec Do Until, on teste après chaque instruction (donc au moins une fois).

Dans le cas qui intéresse ici, je préfère l'utilisation de Do While.

Citation:

---

Envoyé par unparia

Bonjour tototiti2008

Il y a une différence assez importante entre Do While ... Loop et Do Until ..... Loop :
Avec Do While, on teste avant toute exécution des instructions (donc éventuellement 0 fois dans certains cas) , alors qu'avec Do Until, on teste après chaque instruction (donc au moins une fois).

Dans le cas qui intéresse ici, je préfère l'utilisation de Do While.

---

Ce n'est pas exact. Avec Do Until, on ne teste pas au moins une fois, car il est possible, comme avec While, de ne jamais rentrer dans la boucle et donc, avec While comme avec Until, on n'est pas certain d'y entrer au moins une fois.

Do while: Faire TANT QUE => Si la condition n'est pas remplie AVANT l'entrée dans la boucle, il n'y aura pas de boucle.

Do Until: Faire JUSQU'A CE QUE => Si la condition est remplie AVANT l'entrée dans la boucle, il n'y aura pas de boucle.

Si l'on veut exécuter la boucle au moins un fois, on doit utiliser Do et placer la condition en fin de boucle (avec While ou Until).

Code:

---

1 2 3 4

Do ... ... Loop While ...

---

Code:

---

1 2 3 4

Do ... ... Loop Until

---

Rien ne parlera jamais mieux qu'un test -->>

Code:

---

1 2 3 4 5 6 7 8 9 10

toto = False Do While toto = True MsgBox "dedans avec while" ' on n'y entrera jamais toto = True Loop toto = False Do Until toto = True toto = True MsgBox "dedans avec until" ' on y entrera une fois Loop

---

Citation:

---

Envoyé par Pierre Fauconnier

Ce n'est pas exact. Avec Do Until, on ne teste pas (au moins une fois).


Do Until: Faire JUSQU'A CE QUE => Si la condition est remplie AVANT l'entrée dans la boucle, il n'y aura pas de boucle.

---

Bonjour Unparia

Mauvaise foi de ta part si tu répondais à Pierre.

Code:

---

1 2 3 4

toto = True Do Until toto = True MsgBox "dedans avec until" ' on y entrera JAMAIS Loop

---

Bonjour Mercatog

C'est à tototiti2008, que s'adresse ma remarque.
Ce qu'il propose fait entrer dans la boucle même ni EOF d'entrée de jeu.;)

Citation:

---

Envoyé par unparia

Rien ne parlera jamais mieux qu'un test -->>

Code:

---

1 2 3 4 5 6 7 8 9 10

toto = False Do While toto = True MsgBox "dedans avec while" ' on n'y entrera jamais toto = True Loop toto = False Do Until toto = True toto = True MsgBox "dedans avec until" ' on y entrera une fois Loop

---

---

Ah oui?

Avec le code suivant, pas de boucle => "On y entrera une fois" est une assertion erronée.

Code:

---

1 2 3 4 5 6

toto = True Do Until toto = True toto = True MsgBox "dedans avec until" ' on y entrera ZERO FOIS Loop

---

On ne peut pas expliquer la différence entre Do While et Do until en disant que Do Until entre toujours dans la boucle, même si c'est correct dans les cas particuliers cités. La seule façon d'être certain que la boucle est exécutée une fois, c'est d'utiliser Do... Loop [While] [Until]...

Bonjour,
Je confirme c'est beaucoup plus passionnant qu'un GetRows!

Donc ça donnerait

Code:

---

1 2 3 4

Do until recorset.eof ... recordset.movenext Loop

---

Merci a tous

Salut.

@informer

Je ne comprends pas ce que tu dis lorsque tu dis que la suppression d'une ligne Excel désynchronise ton recordset. Le recordset pointe vers la feuille Excel sur laquelle tu supprimes tes lignes? Autrement dit, oShtActive pointe vers MonOnglet?

Si oui, tu as effectivement intérêt à passer par Rs.GetRows pour charger les données dans un array, puis fermer ton recordset et ta connexion, puis boucler sur les lignes de l'array.

Voici un code qui récupère les données du recordset dans un array. Note que l'array est transposé! Cela veut dire tu reçois un tableau à deux dimensions dont la première correspond aux nombres de champs de la requête, et la seconde au nombre de lignes...

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub Test1() Dim rs As ADODB.Recordset Dim Index As Long Dim t Dim Counter As Long   Set rs = getRs("testinvoices") t = rs.getRows rs.Close For Counter = 0 To UBound(t, 2) Index = Evaluate("match(" & t(0, Counter) & ",tinvoice[invoice_pk],0)") Range("tinvoice")(Index).EntireRow.Delete Next End Sub

---

Note que getRs est une procédure à moi. Ce qui t'intéresse, c'est ce qui se passe à partir de la ligne t = rs.getRows
Si ton recordset ne récupère pas les données du tableau duquel tu supprimes des lignes, je te conseille de toute façons de passer par un array pour fermer ta connexion au plus vite. Tu l'ouvres, tu récupères dans un rs, tu transfères dans un array, puis tu fermes rs et connexion. Après, tu travailles "en local" avec l'array.


Si tu travailles sur le recordset directement, voici une procédure qui utilise, comme la précédente, EVALUATE, plus fiable que le FIND qui "singe" Excel. Note que la formule à évaluer est créée ici avec une valeur numérique à faire rechercher par Match (équivalent anglais de EQUIV), et qu'il faut l'adapter si la valeur à chercher est du texte.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12

Sub Test() Dim rs As ADODB.Recordset Dim Index As Long   Set rs = getRs("testinvoices") Do Until rs.EOF Index = Evaluate("match(" & rs.Fields(0).Value & ",tinvoice[invoice_pk],0)") Range("tinvoice")(Index).EntireRow.Delete rs.movenext Loop rs.Close End Sub

---

Salut Pierre,

Dans mon post#3, il y a 2 solutions dont la 1ere qui utilise recordset.getrows sauf que j'utilise ensuite range.find

En effet. J'étais resté sur la désynchronisation du recordset. Bah, tu auras ainsi la solution avec Evaluate que perso, je préfère au Find ;)

Pour mon info personnelle, ton recordset pointe vers le tableau dont tu supprimes des données?

Parce que si oui, je ne comprends pas pourquoi tu travailles avec un recordset. Si non, je ne comprends pas pourquoi il y aurait désynchronisation du rs lors de la suppression d'une ligne dans le tableau.

Quoi qu'il en soit, je ne comprends pas bien l'utilité de la clause Where True... ;)

Oui le recordset pointe sur un plage dont chaque ligne devra être supprimée, l'objectif étant de passer dans un onglet des lignes dont certaines colonnes ont des valeurs particulières dans un onglet d'archivage et de les supprimer de l'onglet source

Code:

---

WHERE True

---

Est une astuce pour plus généralement créer des requêtes dynamiques dont le nombre de critères est variable de 0 à x ainsi je n'ai qu'à ajouter des AND dans ma requête
Réflexe Access quand je dois créer ma requête en fonction de plusieurs listboxes associées à des radiobuttons avec le critère "tous"

Ok. Alors, je ne comprends pas pourquoi tu travailles avec un recordset. il me semblerait plus simple de parcourir la table de données avec un match jusqu'à ce qu'il n'y ait plus de lignes à traiter, et de supprimer/transférer les lignes chaque fois que Match en trouve une.

Voici un code utilisant les références structurées et les possibilités de ListObject qui représente le tableau structuré en VBA, et qui s'appuie sur deux tableaux, t_Actif et t_Archive.

Pièce jointe 520297

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Sub Archivage() Dim Index As Long Dim Target As Range Dim Source As Range Dim Formula   Formula = "iferror(match(""toto"",t_actif[compte],0),0)" Index = Evaluate(Formula) Do Until Index = 0 Set Source = Range("t_actif").ListObject.ListRows(Index).Range Set Target = Range("t_archive").ListObject.ListRows.Add().Range Target.Value = Source.Value Range("t_actif").ListObject.ListRows(Index).Delete Index = Evaluate(Formula) Loop End Sub

---

Je fais un SELECT sur l'onglet source en fonction de critères complexes "NOT IN ou LIKE ou IN sur plusieurs colonnes
La requête évite les boucles à n'en plus finir
De plus une requête est particulièrement lisible et facile à maintenir et on s'affranchie du positionnement des entêtes de colonne
Ensuite dans l'onglet archive,
Range("a" & lastRow+1).copyfromrecordset recordset
Et c'est fini
Puis suppression dans l'onglet source des lignes du recordset pour la valeur du champ incrément qui est unique

Une autre solution serait de passer par Autofilter mais pour l'avoir déjà implémenté, c'est moins lisible et maintenable que du SQL

Ok. Juste pour montrer les possibilités de Match sur des critères complexes...

Voici un tableau dans lequel les lignes en orange respectent les critères suivants:
Compte = Toto et (montant est multiple de 400 ou (date comprise entre 5/12/2018 et 14/07/2019))

Pièce jointe 520320

Voici la ligne qui crée la formule en VBA qui sera évaluée : Formula = "=iferror(MATCH(1,(t_Actif[Compte]=""Toto"")*(((MOD(t_Actif[Valeur],400)=0)+((t_Actif[Date]>=DATE(2018,12,5))*(t_Actif[Date]<=DATE(2019,7,14))))>0),0),0)"
Le code complet utilise une variable Formula pour simplifier la répétition de la formule

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Sub Archivage() Dim Index As Long Dim Target As Range Dim Source As Range Dim Formula As String   Formula = "=iferror(MATCH(1,(t_Actif[Compte]=""Toto"")*(((MOD(t_Actif[Valeur],400)=0)+((t_Actif[Date]>=DATE(2018,12,5))*(t_Actif[Date]<=DATE(2019,7,14))))>0),0),0)" Index = Evaluate(Formula) Do Until Index = 0 Set Source = Range("t_actif").ListObject.ListRows(Index).Range Set Target = Range("t_archive").ListObject.ListRows.Add().Range Target.Value = Source.Value Range("t_actif").ListObject.ListRows(Index).Delete Index = Evaluate(Formula) Loop End Sub

---

Les tableaux après transfert et suppression

Pièce jointe 520322



Je ne cherche pas à tout prix à te convaincre, soyons bien au clair avec cela ;) Après tout, la simplicité est là où l'on veut la voir, et si tu as plus l'habitude des requêtes SQL, critériser en SQL te semblera plus simple/rapide/facile.... Ma solution, donnée sur un forum VBA/Excel, est juste là pour montrer que l'on peut réfléchir "en Excel" dans du code vba fait pour Excel, sans devoir faire appel à une bibliothèque externe (ADODB) et connaître le SQL pour arriver à un chouette résultat, ce qui nécessite des connaissances informatiques "de programmeur", simplement en utilisant les ressources natives d'Excel et les tableaux structurés, qui simplifient le code (Voir ma signature à propos de VBA pour Excel) ;)

Les limites du SQL pour Excel (INSERT à cause de colonnes non typées à coup sûr, DELETE absent des instructions SQL pour Excel, un seul niveau de Left Join, ...) m'amènent à ne jamais utiliser ce type de traitement sur Excel.