Discussion :

[informer]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

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?

[Thumb down]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[informer]

Il faut effectivement passer par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[tototiti2008]

Bonjour,

informer, juste une remarque de pinailleur de ma part

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Do While Not

peut s'écrire

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Do Until

[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.

[Pierre Fauconnier]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Do
  ...
  ...
Loop While ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Do
  ...
  ...
Loop Until

[unparia]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Pierre Fauconnier]

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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]...

[mercatog]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[unparia]

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.

[Thumb down]

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

[informer]

Donc ça donnerait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Do until recorset.eof
...
recordset.movenext
Loop

Merci a tous

[Pierre Fauconnier]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[informer]

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

[Pierre Fauconnier]

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...

[informer]

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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"

[Pierre Fauconnier]

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.

[informer]

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

[Pierre Fauconnier]

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.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

[Pierre Fauconnier]

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))



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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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





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.