XL 2016 Boucle

Aldonanou

XLDnaute Junior
Bonjour,

J'aimerai pouvoir copier le nom du gestionnaire présent en colonne D en face des lignes correspondantes à sa gestion. Bien sûr je ne connais pas à l'avance le nombre de lignes pour chaque gestionnaire. J'étais partie sur l'idée que : si la cellule B contient le mot "gestionnaire :" alors je récupère la valeur offset(,2) et effectue une copie de la valeur 3 lignes en dessous et tant que le numéro de produit est complété (colonne C).

Grâce à jm.andryszak j'avais pu finaliser une précédente demande. Mais cette fois-ci, je ne suis pas dans le même schéma puisque l'information relative au nom du gestionnaire ne se trouve pas dans la même cellule mais dans une cellule adjacente. Je ne peux donc pas utiliser :
(Split(Mid(Adresses, 2), ":")) - 1

J'ai bien compris qu'il fallait partir sur le même principe de recherches d'adresses pour localiser les lignes contenant les informations, cette partie est ok pour la ligne concernée mais cela remonte l'information de la cellule B (normal c'est ce qui est écrit) mais comment faire pour la cellule D.

Option Explicit
Dim Adresses
Private Sub ChercheAddresses()
'https://stackoverflow.com/questions/30380490/find-and-findnext-for-excel-vba
Dim c As Range
Dim FirstAddress

With Range("b:b")
Set c = .FIND("GESTIONNAIRE*", LookIn:=xlValues)
If Not c Is Nothing Then
FirstAddress = c.Address
Do
Adresses = Adresses & ":" & c.Address
Set c = .FindNext(c)
Loop While c.Address <> FirstAddress
End If
End With
End Sub

Sub Essai()
Dim Plage As Range
Dim DerniereLigne
Dim i, j
Dim Debut
Debut = Timer
Adresses = vbNullString
Application.ScreenUpdating = False
Range("b:b").Offset(, 3).ClearContents
ChercheAddresses
'Debug.Print Adresses
'
For i = 0 To UBound(Split(Mid(Adresses, 2), ":")) - 1
Set Plage = Range(Split(Mid(Adresses, 2), ":")(i) & ":" & Split(Mid(Adresses, 2), ":")(i + 1))
For j = 1 To Plage.Rows.Count
If Plage.Offset(, 2).Cells(j, 1) <> "" And Plage.Offset(, 2).Cells(j, 1) <> "Produit" Then
Plage.Offset(, 3).Cells(j, 1) = Split(Plage(1, 1), ":")(1)
End If
Next
Next

'Dernière Plage
i = Split(Split(Adresses, ":")(UBound(Split(Adresses, ":"))), "$")(2)
DerniereLigne = Range("d" & Rows.Count).End(xlUp).Row
Set Plage = Range("e" & i & ":" & "e" & DerniereLigne - 4).Offset(4, 0)
Plage.Value = Split(Range(Split(Adresses, ":")(UBound(Split(Adresses, ":")))), ":")(1)
Application.ScreenUpdating = True
'
MsgBox Timer - Debut
End Sub


Je joins un fichier pour une meilleure compréhension.

Merci.
 

Pièces jointes

  • Aide boucle produits.xlsx
    15.5 KB · Affichages: 6
Solution
De toute façon, moi je l'aurais plutôt écrit à peu près dans ce style :
VB:
   Dim TInit(), LI As Long, TResu(), LR As Long, C As Integer, Nom As String
   TInit = Feuil1.UsedRange.Value
   ReDim TResu(1 To UBound(TInit, 1), 1 To UBound(TInit, 2))
   For LI = 1 To UBound(TInit)
      If TInit(LI, 1) = "Gestionnaire :" Then
         Nom = TInit(LI, 3)
      Else
         LR = LR + 1
         TResu(LR, 1) = Nom
         For C = 2 To UBound(TResu, 2)
            TResu(LR, C) = TInit(LI, C)
            Next C
         End If
      Next LI
   Cells(15, 1).Resize(LR, 20).Value = TResu
   End Sub

cp4

XLDnaute Barbatruc
Bonjour,
@Dranreb Bonjour;)

@Aldonanou : si j'ai compris la problématique. Copier coller le code dans un module standard et surtout enregistrer comme signalé par Dranreb, ton fichier en xlsm (acceptant les macros).
VB:
Option Explicit

Sub restitution()
   Dim plg As Range, Cel As Range, i As Integer, gest As String

   Set plg = ThisWorkbook.Sheets("fichier initial").UsedRange
   For i = 1 To plg.Rows.Count
      If plg(i, 2) = "Gestionnaire :" Then gest = plg(i, 2).Offset(0, 2)
      If plg(i, 2) = "Etat" Then plg(i, 2) = "Gestionnaire"
      If plg(i, 2) = "" And plg(i, 2).Offset(0, 1) <> "" Then plg(i, 2) = gest
   Next i
   'suppression des lignes
   For i = plg.Rows.Count To 1 Step -1
      If plg(i, 2) = "Gestionnaire :" Then Rows(i).Delete
      Debug.Print i
   Next i
End Sub
Bonne journée.
 
Dernière édition:

Dranreb

XLDnaute Barbatruc
De toute façon, moi je l'aurais plutôt écrit à peu près dans ce style :
VB:
   Dim TInit(), LI As Long, TResu(), LR As Long, C As Integer, Nom As String
   TInit = Feuil1.UsedRange.Value
   ReDim TResu(1 To UBound(TInit, 1), 1 To UBound(TInit, 2))
   For LI = 1 To UBound(TInit)
      If TInit(LI, 1) = "Gestionnaire :" Then
         Nom = TInit(LI, 3)
      Else
         LR = LR + 1
         TResu(LR, 1) = Nom
         For C = 2 To UBound(TResu, 2)
            TResu(LR, C) = TInit(LI, C)
            Next C
         End If
      Next LI
   Cells(15, 1).Resize(LR, 20).Value = TResu
   End Sub
 

cp4

XLDnaute Barbatruc
Bonjour,
Mais je ne comprends pas pourquoi la solution de cp4 ne remonte aucune information.
J'ai testé chez-moi et fonctionne parfaitement. Je suis incapable de te dire pourquoi ça ne fonctionne pas chez-toi.
Aide boucle produits.gif
 

Aldonanou

XLDnaute Junior
Bonjour cp4 je regarde au travail tout à l’heure. Merci
Bonjour, après avoir retenté le tout, je n'obtiens toujours rien.
Capture.PNG

Franchement, je ne comprends pas car c'était vraiment une solution géniale.

La valeur gest est toujours vide, or elle devrait se compléter à chaque fois qu'une valeur est trouvée. J'ai l'impression que cette partie du code "gest = plg(i, 2).Offset(0, 2) " ne fonctionne pas. Dans ma fenêtre d'exécution j'ai bien 18 lignes qui correspondent à mon tableau. Les limites de mon tableau sont conformes.

Qu'en pensez-vous d'autant que j'utilise le même fichier que celui que je vous ai transmis.

Merci

Cordialement

Aldonanou
 

cp4

XLDnaute Barbatruc
Qu'en pensez-vous d'autant que j'utilise le même fichier que celui que je vous ai transmis.
Sur le même fichier, c'est bizarre. Chez-moi ça fonctionne.

La valeur gest est toujours vide, or elle devrait se compléter à chaque fois qu'une valeur est trouvée. J'ai l'impression que cette partie du code "gest = plg(i, 2).Offset(0, 2) " ne fonctionne pas
En colonne B (2) est inscrit Gestionnaire : et à 2 cellules vers la droite est inscrit le code suivi du prénom, c'est à dire plg(i,2).Offset(0,2).
Vérifie l'orthographe de Gestionnaire : en colonne B
Fait un débogage pour trouver où se situe l'erreur (peut-être dans l'offset (fichier pas exactement le même)).
Essaie comme ceci
VB:
Sub restitution()
   Dim plg As Range, Cel As Range, i As Integer, gest As String, j As Integer

   Set plg = ThisWorkbook.Sheets("fichier initial").UsedRange
   For i = 1 To plg.Rows.Count
      Debug.Print plg(i, 2), plg(i, 2).Offset(0, 2)
'      If plg(i, 2) = "Gestionnaire :" Then gest = plg(i, 2).Offset(0, 2)
'      If plg(i, 2) = "Etat" Then plg(i, 2) = "Gestionnaire"
'      If plg(i, 2) = "" And plg(i, 2).Offset(0, 1) <> "" Then plg(i, 2) = gest
   Next i
   'suppression des lignes
'   For i = plg.Rows.Count To 1 Step -1
'      If plg(i, 2) = "Gestionnaire :" Then Rows(i).Delete
'      Debug.Print i
'   Next i
End Sub
Pour afficher ceci
Aide boucle produits.JPG



Bonne journée.
 

Aldonanou

XLDnaute Junior
Bonjour Cp4,

Les vérifications sur les divers points ont été effectuées, il n'y a pas d'erreurs.

J'avais même commenté votre code afin de m'assurer de bien le comprendre. Mais je n'ai aucune remontée.

Je vais essayé chez moi. Car je ne comprends pas. Même si je suis autodidacte sur la rédaction des codes VBA, en général je suis capable d'adapter in fine mais là !

Merci je reviens vers vous.

Cordialement

Aldonanou

VB:
Sub restitution()
   Dim plg As Range, Cel As Range, i As Integer, gest As String
  
   Set plg = ThisWorkbook.Sheets("fichier initial").UsedRange

   For i = 1 To plg.Rows.Count ' de la ligne 1 à la dernière ligne
      If plg(i, 2) = "Gestionnaire :" Then gest = plg(i, 2).Offset(0, 2)
      If plg(i, 2) = "Etat" Then plg(i, 2) = "Gestionnaire" 'si plg = "Etat" alors remplace la valeur de la cellule par gestionnaire
      If plg(i, 2) = "" And plg(i, 2).Offset(0, 1) <> "" Then plg(i, 2) = gest 'si plg est vide et la colonne adjacente à plg est différente de vide alors plg = gest
   Next i
   'suppression des lignes
   For i = plg.Rows.Count To 1 Step -1
      If plg(i, 2) = "Gestionnaire :" Then Rows(i).Delete
      Debug.Print i
   Next i
End Sub
 

cp4

XLDnaute Barbatruc
Bonjour Aldonanou,

Moi aussi, je suis autodidacte. Je t'avoue que moi aussi je ne comprends pas d'autant plus que tu dis que c'est le même fichier. Je te joins ton fichier pour vérifier si ça fonctionne avec ce dernier.
 

Pièces jointes

  • Aide boucle produits.xlsm
    28.6 KB · Affichages: 5

Discussions similaires

Réponses
11
Affichages
431
Réponses
2
Affichages
423

Statistiques des forums

Discussions
313 204
Messages
2 096 206
Membres
106 528
dernier inscrit
Sabrnajean