Microsoft 365 Créer une boucle sur une plage de cellules

Dravol · 2 Juin 2022

Bonjour à tous,

Je cherche à créer une boucle plutôt que de créer 150 lignes de code. pouvez-vous m'aider ?

If CStr([C148]) <> "" And Intersect(ActiveCell, [D148]) Is Nothing Then _
If CStr([D148]) = "" Then [D148].Select: MsgBox "Renseignez le problème ex : HS, perdu..."
End Sub

Si je continue dans ma logique (sans boucle), je vais avoir ce même code répété jusqu'à la ligne 287.

If CStr([C149]) <> "" And Intersect(ActiveCell, [D149]) Is Nothing Then _
If CStr([D149]) = "" Then [D149].Select: MsgBox "Renseignez le problème ex : HS, perdu..."
End Sub

If CStr([C150]) <> "" And Intersect(ActiveCell, [D150]) Is Nothing Then _
If CStr([D150]) = "" Then [D150].Select: MsgBox "Renseignez le problème ex : HS, perdu..."
End Sub

etc etc...

pouvez-vous me donner la ligne de code pour une boucle de la ligne 148 à à 287 ?

Merci d'avance

Drav

Hasco · 2 Juin 2022

bonjour,

Euh.... Au bas de cette page, dans discussion similaires il y a des réponses à ce genre de demande dont celle de cette discussion (résolue) d'un certain @Dravol :

XL 2019 - Créer une boucle

Bonjour à tous, Je souhaiterais créer une boucle avec le code ci-dessous afin de répéter le renseignement de [R24:R43,R45:R48] avec [L24:L43,L45:L48]. càd Si R25 non vide, documenter L25 Si R26 non vide, documenter L26 ..... ..... Voici mon code qui fonctionne bien sur ma...

www.excel-downloads.com

Faut pas exagérer quand même !

soan · 2 Juin 2022

Bonjour Drav, Hasco,

je propose ce code VBA (non testé ; si besoin, à adapter) :

VB:

Option Explicit

Sub Essai()
  Dim lig&
  For lig = 148 To 287
    With Cells(lig, 3)
      If CStr(.Value) <> "" And _
          ActiveCell.Address(0, 0) <> "D" & lig Then
        If CStr(.Offset(, 1)) = "" Then
          Application.Goto .Offset(, 1), True
          MsgBox "Renseignez le problème ex : HS, perdu..."
        End If
      End If
    End With
  Next lig
End Sub

l'ennui, c'est qu'en pratique, après le message de la MsgBox, il faudrait « redonner la main » à l'utilisateur pour qu'il puisse faire une saisie dans la cellule où il manque un renseignement ; mais y'a un gros hic : pour ça, il faudrait sortir de la sub ! et si on quitte la sub, on ne peut plus continuer la boucle ! c'est dans le genre du « serpent qui se mord la queue » ! il faudrait essayer de trouver une autre méthode qui soit plus adaptée à ce que tu veux faire ; mais peut-être que si on fait la saisie dans la boucle via un InputBox, ça pourrait marcher ? à toi de voir, et bonne chance !

soan

Hasco · 2 Juin 2022

bonjour,

C'est l'histoire de l'homme qui voulait manger du poisson mais qui ne savais (voulais ?) pas pêcher...

soan · 2 Juin 2022

@Hasco

je viens de suivre le lien que tu as indiqué dans ton post #2 ; c'est effectivement le même genre d'exo, proposé aussi par Dravol, mais ce qui est drôle, c'est que c'est un sujet du 6 janvier 2021 ! comme c'était y'a plus d'un an, je suppose que Dravol a simplement oublié son ancien exo et la réponse associée qu'il avait obtenu !

soan

Deadpool_CC · 2 Juin 2022

alzheimer ? (je rigole)

soan · 2 Juin 2022

@Deadpool

Deadpool_CC à dit:
alzheimer ? (je rigole)

non, pas alzeimer, mais n'oublie pas que certains membres du site sont très âgés (par exemple des retraités) ; et avec l'âge, la mémoire s'amenuise... il y a aussi des personnes étourdies qui oublient facilement des choses ; même si Drav est ni une personne âgée, ni étourdi, ça peut arriver à n'importe qui d'oublier quelque chose ! surtout si c'était y'a un an ! si toi tu as la chance de ne rien oublier, même après un an, alors tu peux te vanter d'avoir une mémoire d'éléphant !

pas vrai, Dumbo ? ... oui, Dumbo a confirmé ! il m'a même appris que s'il a une mémoire phénoménale, c'est pour se rappeler du chemin qu'il avait appris quand il n'était alors qu'un petit éléphanteau ! ah ? quel chemin ? celui qui mène (hélas) au cimetière des éléphants ! les braconniers chasseurs d'ivoire sont priés de passer leur chemin et de ne pas chercher à suivre mon ami Dumbo !

soan

Deadpool_CC · 2 Juin 2022

soan à dit:
... mais n'oublie pas que ...

Mince ... j'avais oublié ... certainement à cause de mon propre alzeimer ... lol

Dravol · 3 Juin 2022

Bonjour à tous,

En fait je vais vous expliquer.
à l'époque par manque de temp, je n'ai pas voulu laisser le post en attente plusieurs mois et je l'avais validé en solution mais dans les faits je n'arrivais pas à faire fonctionner les différentes solutions proposées

Désolé pour cette redondance de post et non je n'ai pas Alzheimer

Drav.

Du coup je mets en dessous l'ensemble de code qui fonctionne mais sans la boucle.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim HCoché As Boolean, TV()
If Target.CountLarge = 1 Then
If Not Intersect([H18,J18], Target) Is Nothing Then
HCoché = IsEmpty([J18].Value)
[H18].Value = IIf(HCoché, Empty, ChrW(&H2713))
[J18].Value = IIf(HCoché, ChrW(&H2713), Empty)
ElseIf Not Intersect([B148:C287], Target) Is Nothing Then
TV = Array(Empty, Empty, Empty)
TV(Target.Column - 2) = ChrW(&H2713)
[B:C].Rows(Target.Row).Value = TV
End If
End If

If CStr([C148]) <> "" And Intersect(ActiveCell, [D148]) Is Nothing Then _
If CStr([D148]) = "" Then [D148].Select: MsgBox "Renseignez le problème ex : HS, perdu..."

If CStr([C149]) <> "" And Intersect(ActiveCell, [D149]) Is Nothing Then _
If CStr([D149]) = "" Then [D149].Select: MsgBox "Renseignez le problème ex : HS, perdu..."

If CStr([C150]) <> "" And Intersect(ActiveCell, [D150]) Is Nothing Then _
If CStr([D150]) = "" Then [D150].Select: MsgBox "Renseignez le problème ex : HS, perdu..."

If CStr([C151]) <> "" And Intersect(ActiveCell, [D151]) Is Nothing Then _
If CStr([D151]) = "" Then [D148].Select: MsgBox "Renseignez le problème ex : HS, perdu..."

idem 152
idem153
... jusqu'à 287

Drav

Microsoft 365 Créer une boucle sur une plage de cellules

Dravol

XLDnaute Junior

Hasco

XLDnaute Barbatruc

XL 2019 - Créer une boucle

soan

XLDnaute Barbatruc

Hasco

XLDnaute Barbatruc

soan

XLDnaute Barbatruc

Deadpool_CC

XLDnaute Accro

soan

XLDnaute Barbatruc

Deadpool_CC

XLDnaute Accro

Dravol

XLDnaute Junior

Discussions similaires