ClearContents dans Do Loop While

[cibleo]

Bonsoir le forum,

Pour comprendre cette macro de recherche , entrez successivement les 2 valeurs suivantes : 25 et 35

Comme vous le voyez, toutes les lignes (des feuilles "Encais) dont les valeurs sont comprises dans cet intervalle sont recopiées.

Dans la boucle Do...Loop While, ceci :

Range(Ws.Cells(cel.Row, 1), Ws.Cells(cel.Row, 7)).Copy ShtR.Cells(DerLiR, 1)

La plage de recherche regroupe les colonnes E, F er G

Set plage = .Range("E2:G" & DerLiS) 'ici plage de recherche

Des valeurs hors intervalle peuvent donc être recopiées si elles se trouvent sur la même ligne.

J'aimerais, qu'à chaque itération dans Do ...Loop while, effacer ces valeurs "parasites".
J'ai bien pensé à décomposer la 1ère instruction en 2 parties mais le formatage n'est pas recopié (Bordures)

A la sortie de la boucle, j'ai aussi pensé au bloc ci-dessous qui efface bien ces valeurs.

.../...
If DerLiR > 1 Then
    trouve = True
       Set plage1 = ShtR.Range("E2:G" & DerLiR)
    For Each cel1 In plage1 'efface de la plage les valeurs parasites (hors intervalle)
      If Not IsEmpty(cel1) Then
        If cel1 < v1 Or cel1 > v2 Then
          cel1.Value = ""
        End If
      End If
    Next cel1
 End If
.../...

Problème, dans le fichier initial figurent des instruction qui m'affichent dynamiquement les totaux mensuels des colonnes E, F, G.

Ces instructions sont placées dans la boucle Do...Loop While et prennent donc en compte ces valeurs "parasites".
Conclusion les totaux affichés sont faussés puisque j'efface les valeurs "parasites" sur la fin de mon code.

Ci-dessous les instructions du fichier initial figurant dans la boucle Do...Loop While me permettant d'effectuer les totaux.

Dim Mois As Integer, Valmois(12, 3) As Single, Nbmois(12, 3) As Integer
.../...
        Mois = Month(ShtR.Cells(DerLiR, 1))                         'Récup n° du mois
        If ShtR.Cells(DerLiR, 5) <> 0 Then
        Valmois(Mois, 1) = Valmois(Mois, 1) + ShtR.Cells(DerLiR, 5) 'Cumul Espèces
        Nbmois(Mois, 1) = Nbmois(Mois, 1) + 1                       'Comptage Espèces
        End If
 
        If ShtR.Cells(DerLiR, 6) <> 0 Then
        Valmois(Mois, 2) = Valmois(Mois, 2) + ShtR.Cells(DerLiR, 6) 'Cumul Chéques
        Nbmois(Mois, 2) = Nbmois(Mois, 2) + 1                       'Comptage Chèques
        End If
 
        If ShtR.Cells(DerLiR, 7) <> 0 Then
        Valmois(Mois, 3) = Valmois(Mois, 3) + ShtR.Cells(DerLiR, 7) 'Cumul Virements
        Nbmois(Mois, 3) = Nbmois(Mois, 3) + 1                       'Comptage Virements
        End If
../...

Pouvez-vous m'aider ?
Merci Cibleo

Ps : le surlignage en bleu, c'est pour bien visualiser la problématique.

 

[Banzai64]

Re : ClearContents dans Do Loop While

Bonjour

A voir et à tester

Encaissement V001.zip

 

[cibleo]

Re : ClearContents dans Do Loop While

Bonjour Banzai64 🙂
Bonjour à tous,

Super, dans l'immédiat, je retiens bien cette partie à intégrer dans Do...Loop While

' Variable rajoutée
  Dim J As Byte
.../...
' Début du code rajouté
  With ShtR
     For J = 5 To 7
        If .Cells(DerLiR, J) < v1 Or .Cells(DerLiR, J) > v2 Then
          .Cells(DerLiR, J).ClearContents
        End If
     Next J
  End With
' Fin du code rajouté
.../...

Pour le complément, je continue à tester et reviens si problème.
Merci Cibleo