Besoin d'une macro loop

Résolu
Bonjour,

Voir document enregistré dans l image. je voudrais créee une macro boucle qui descend la colonne B et quand elle rencontre la cellule qui contient la chaine de texte "S/Total R2017" elle la remplace par la cellule placé avant elle de 3 Dans l'exemple cela remplace B22 par B19 et B29 par B26 et la marco s'arrete quand y plus rien

Alors je voulais faire une boucle avec step 3 mais je sais pas comment trouver une cellue chaine de texte et surtout la remplacer par cellule - 3

Merci d'avance

Cdt

20 réponses

  1. Contributeur
    Tu as tout a fait raison, on peut le faire autrement avec Left

    Il n'y a que les imbéciles qui ne changent pas d'avis!

    A méditer

    Option Explicit
    Private Sub CommandButton1_Click()
     Dim Tableau() As String
     Dim nom As String
     Dim FL1 As Worksheet, NoCol, i As Integer
    Dim NoLig As Long, Var As Variant
    Dim DernLigne As Long
    DernLigne = Range("B1048576").End(xlUp).Row
        Set FL1 = Worksheets("Feuil1")
        NoCol = 2 'lecture de la colonne B
        For NoLig = 1 To DernLigne
            Var = FL1.Cells(NoLig, NoCol)
       nom = Left(Var, 13)
       If nom = "S/Total R2017" Then
            Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
           Application.CutCopyMode = False
        End If
       Next
        Set FL1 = Nothing
    End Sub
    


    Et pour faire un peu d'esprit, je dirais que la boucle est bouclée LOL

    @+ Le Pivert
    1. mdrrr, bien vu.

      Voila j'etais plus sur une idée comme ça du coup ca marche, c'est top merci :)
  2. je pensais pouvoir utiliser une fonction excel genre Len un truc comme ça, mais si tu l'as fait c'est que ca doit être ca, encore une fois je suis un petit débutant malheureusement, j'aimerai bien qu'on puisse faire comme dans matrix.
    1. Contributeur
      Cela vient peut-être de la boucle, essaie ceci:

      Option Explicit
      Private Sub CommandButton1_Click()
       Dim Tableau() As String
       Dim nom As String
       Dim nom_2 As String
       Dim FL1 As Worksheet, NoCol, i As Integer
      Dim NoLig As Long, Var As Variant
      Dim DernLigne As Long
      DernLigne = Range("B1048576").End(xlUp).Row
          Set FL1 = Worksheets("Feuil1")
          NoCol = 2 'lecture de la colonne B
          For NoLig = 1 To DernLigne
              Var = FL1.Cells(NoLig, NoCol)
         'découpe la chaine en fonction des espaces "/"
          'le résultat de la fonction Split est stocké dans un tableau
          Tableau = Split(Var, "/")
                     For i = 0 To UBound(Tableau)
                    Debug.Print Tableau(i)
                   Next i
                   nom = Tableau(0) '1èrechaine = S
               If nom = "S" Then
                nom_2 = Tableau(1)  '2ème chaine = Total R2017
                 If nom_2 = "Total R2017" Then
               Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
             Application.CutCopyMode = False
             End If
             End If
         Next
          Set FL1 = Nothing
      End Sub
      


      meme si je vois pas l'interet de decomposer en tableau

      comment fais-tu pour déterminer la présence de:

      S/Total R2017 ?????

      par contre si tu avais voulu trouver:

      S/Total R2017/00027

      pas de tableau

      Var aurait suffit!!!!!!!!

      @+ Le Pivert


      1. je pense que sinon la macro marche c'est juste ca le soucis,
        1. Je vais te payer pour quelques cours lol, mais expliquer comme ca j'ai compris ce que tu me dit, meme si je vois pas l'interet de decomposer en tableau. j'aurai jamais penser a utiliser split et var, du coup je me dis juste que je suis loin. Le probleme la c'est juste que l'occurence tableau (0) bloque la macro c'est tout. En tous cas merci d'avoir pris de ton temps
          1. Contributeur
            le boucle parcourt les cellules

            var est le texte dans chaque cellule parcourue

            quand il arrive sur une cellule qui contient le séparateur, en l’occurrence ici: "/", Split la décompose en un tableau

            S/Total R2017/00027

            ici il y a 2 séparateurs et 3 chaines à décomposer

            Tableau
            0 = S
            1 = Total R2017
            2 = 00027

            donc quand on trouve Total R2017 on a la ligne et il suffit de faire un copier coller

            C'est simple!!!!!!!!!!

            @+ Le Pivert


            1. En fait ca me met ca (voir capture ecran à chaque fois) ca fait un bogue. et ca me met que ca ne trouve pas l occurence. le problème c'est que je comprend ta macro jusqu'au split, ensuite je comprend plus rien avec var etc... donc j'ai du mal à la retravailler.
              1. Contributeur
                Pour l'erreur met des MsgBox pour voir comme ceci:

                   Var = FL1.Cells(NoLig, NoCol)
                MsgBox Var
                   'découpe la chaine en fonction des  "/"
                    'le résultat de la fonction Split est stocké dans un tableau
                    Tableau = Split(Var, "/")
                               For i = 0 To UBound(Tableau)
                              Debug.Print Tableau(i)
                             Next i
                             nom = Tableau(0) '1èrechaine = S
                MsgBox nom
                
            2. Contributeur
              Voilà une autre version de Split avec comme séparateur "/"

              Option Explicit
              Private Sub CommandButton1_Click()
               Dim Tableau() As String
               Dim nom As String
               Dim nom_2 As String
               Dim FL1 As Worksheet, NoCol, i As Integer
              Dim NoLig As Long, Var As Variant
                  Set FL1 = Worksheets("Feuil1")
                  NoCol = 2 'lecture de la colonne B
                  For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
                      Var = FL1.Cells(NoLig, NoCol)
                 'découpe la chaine en fonction des  "/"
                  'le résultat de la fonction Split est stocké dans un tableau
                  Tableau = Split(Var, "/")
                             For i = 0 To UBound(Tableau)
                            Debug.Print Tableau(i)
                           Next i
                           nom = Tableau(0) '1èrechaine = S
                       If nom = "S" Then
                        nom_2 = Tableau(1)  '2ème chaine = Total R2017
                         If nom_2 = "Total R2017" Then
                       Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
                     Application.CutCopyMode = False
                     End If
                     End If
                 Next
                  Set FL1 = Nothing
              End Sub
              
              1. En gros ce que je cherche a faire, c'est que la macro descende la colonne b est quand elle trouve dans une cellule la chaine de caractères " S/Total R2017", elle remplace dans cette cellule par le nom de la cellule situé 3 ligne au dessus. et ca s'arrte quand elle arrive à la fin de la colonne, des qu'(ily a une cellule vide.
                1. Contributeur
                  C'est normal que cela bug, si dans ta colonne il y a des chaines de caractères sans espace!

                  Que cherches-tu à faire?

                  Regarde ce que fait ce code, tu comprendras mieux:

                  Option Explicit
                  Private Sub CommandButton1_Click()
                   Dim Tableau() As String
                   Dim nom As String
                   Dim FL1 As Worksheet, NoCol, i As Integer
                  Dim NoLig As Long, Var As Variant
                      Set FL1 = Worksheets("Feuil1")
                      NoCol = 2 'lecture de la colonne B
                      For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
                          Var = FL1.Cells(NoLig, NoCol)
                     'découpe la chaine en fonction des espaces " "
                      'le résultat de la fonction Split est stocké dans un tableau
                      Tableau = Split(Var, " ")
                                 For i = 0 To UBound(Tableau)
                               Debug.Print Tableau(i)
                               Next i
                               nom = Tableau(0) '1èrechaine = S/Total
                           If nom = "S/Total" Then
                           MsgBox Tableau(1) '2ème chaine = R2017/00027
                       ' Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
                  'Application.CutCopyMode = False
                         End If
                     Next
                      Set FL1 = Nothing
                  End Sub
                  


                  en plus j'ai pas vu le (2)

                  Si il n'y a qu'un espace, tu ne verras jamais le 2, ça buguera!!!!!!!!!!

                  @+ Le Pivert
                  1. Je comprend mais ca me bogue "indice n'appartient pas à la selection)

                    en plus j'ai pas vu le (2)
                    1. Contributeur
                      C'est indiqué dans la macro:

                       nom = Tableau(0) '1èrechaine = S/Total


                      la séparation se fait à chaque espace:

                       nom = Tableau(1) '2ème chaine = R2017/00027 


                      le tableau commence à 0

                      Si tu enleves l'apostrophe à cette ligne tu verras le résultat en bas

                      ' Debug.Print Tableau(i)

                      Tout est expliqué dans le site que j'ai mentionné

                      'Le résultat s'affiche dans la fenêtre d'execution de l'éditeur de macros
                      Debug.Print Tableau(i)


                      @+ Le Pivert
                      1. Dernière chose, l'occurence (nom = Tableau(0)) dans ta macro elle signifie quoi?
                        1. J'avais déja fait pour essayer d'enlever, mais merci beaucoup je vais essayer de me débrouiller avec votre deuxième macro. J'etais loin de pouvoir faire une macro comme ça en fait lol
                          1. Contributeur
                            Voilà un exemple dans le Feuille 1 colonne B a adapter:

                            Option Explicit
                            Private Sub CommandButton1_Click()
                             Dim Tableau() As String
                             Dim nom As String
                             Dim FL1 As Worksheet, NoCol, i As Integer
                            Dim NoLig As Long, Var As Variant
                                Set FL1 = Worksheets("Feuil1")
                                NoCol = 2 'lecture de la colonne B
                                For NoLig = 1 To Split(FL1.UsedRange.Address, "$")(4)
                                    Var = FL1.Cells(NoLig, NoCol)
                               'découpe la chaine en fonction des espaces " "
                                'le résultat de la fonction Split est stocké dans un tableau
                                Tableau = Split(Var, " ")
                                           For i = 0 To UBound(Tableau)
                                        '  Debug.Print Tableau(i)
                                         Next i
                                    nom = Tableau(0) '1èrechaine = S/Total
                                    If nom = "S/Total" Then
                                  Range("B" & NoLig - 3).Copy ActiveSheet.Range("B" & NoLig) 'copier coller
                            Application.CutCopyMode = False
                                   End If
                               Next
                                Set FL1 = Nothing
                            End Sub
                            

                            1. C'est dommage car ca ne march pas? la fonction me dit ne pas trouver la chaine de caractères "S/Total R2017" dans $B :$B

                              alors qu'elle s y trouve bien
                              1. Bonjour merci beaucoup,

                                Je n'aurais surment pas été capable de refaire la meme chose
                                1. Contributeur
                                  Bonjour,

                                  Voir ceci:

                                  https://forums.commentcamarche.net/forum/affich-37621992-methode-find-dans-vba-recherche-de-donnees-sous-excel

                                  Ce qui donne pour la Feuille1 et la colonne A, a adapter:

                                  Sub Principale()
                                  Dim Plage As Range
                                  Dim Lignes(), i As Long
                                  Dim Texte As String
                                  Dim Flag As Boolean
                                  Dim maligne As Integer
                                  Set Plage = Sheets("Feuil1").Columns(1) 'plage de recherche colonne A
                                  Texte = "S/Total R2017"   'expression cherchée
                                  Flag = Find_Next(Plage, Texte, Lignes())  'appel de la fonction
                                  If Flag Then  'si fonction retourne Vrai = expression trouvée dans la plage
                                      For i = LBound(Lignes) To UBound(Lignes)   'restitution des lignes correspondantes
                                         maligne = Lignes(i)
                                    Range("A" & maligne - 3).Copy ActiveSheet.Range("A" & maligne) 'copier coller
                                  Application.CutCopyMode = False
                                     Next i
                                  Else
                                      MsgBox "L'expression : " & Texte & " n'a pas été trouvée dans la plage : " & Plage.Address
                                  End If
                                  End Sub
                                  
                                  'Sources : Michel_m
                                  'http://www.commentcamarche.net/forum/affich-31432413-importation-de-donnees-sans-doublons#9
                                  Function Find_Next(Rng As Range, Texte As String, Tbl()) As Boolean
                                  Dim Nbre As Integer, Lig As Long, Cptr As Long
                                  
                                      Nbre = Application.CountIf(Rng, Texte)
                                      If Nbre > 0 Then
                                          ReDim Tbl(Nbre - 1)
                                          Lig = 1
                                          For Cptr = 0 To Nbre - 1
                                              Lig = Rng.Find(Texte, Cells(Lig, Rng.Column), xlValues).Row
                                              Tbl(Cptr) = Lig
                                          Next
                                      Else
                                          GoTo Absent
                                      End If
                                      Find_Next = True
                                      Exit Function
                                  Absent:
                                      Find_Next = False
                                  End Function