XL 2016 Boucle

[Aldonanou]

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.

 

[Dranreb]

Bonjour.
Pourquoi avoir joint un xlsx au lieu du xlsm ?
Ne notez pas les adresses de cellules, notez les cellules elles mêmes.

 

[cp4]

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

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.

 

[Dranreb]

De toute façon, moi je l'aurais plutôt écrit à peu près dans ce style :

   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

 

[Aldonanou]

Bonjour à vous,

Merci pour vos solutions. Celle de Dranreb fonctionne à merveille. Mais je ne comprends pas pourquoi la solution de cp4 ne remonte aucune information.
Merci encore.

 

[cp4]

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.

 

[Aldonanou]

Bonjour cp4 je regarde au travail tout à l’heure. Merci

 

[Aldonanou]

Bonjour cp4 je regarde au travail tout à l’heure. Merci

Bonjour, après avoir retenté le tout, je n'obtiens toujours rien.

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]

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

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

Bonne journée.

 

[Aldonanou]

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

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]

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.

 

[Aldonanou]

Cp4,

Merci il fait nuit chez moi alors je regarderai demain.

Bonne journée

 

[Aldonanou]

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.

Bonjour Cp4,

Cela fonctionne à merveille chez moi. je testerai lundi au travail.

Merci beaucoup

Cordialement

Aldonanou