VBA créer une boucle ???

Résolu
bocman -  
Bonjour,
Je ne sais pas créer une boucle si quelqu'un pourrai m'aider.
En faite ce que je voudrais c'est :
la cellule Ai = la cellule Bi
si Bi = quelque chose alors Ai = bi
Sinon
"on répéate le programme"
si Bi+1 = quelque alors Ai= bi +1
...............

voici le début de mon programme

Function boucle()
If Sheets("feuil2").Range("a1").Value <> "" Then
boucle = Sheets("feuil2").Range("a1").Value
Else
If Sheets("feuil2").Range("a2").Value <> "" Then
boucle = Sheets("feuil2").Range("a2").Value
Else
If Sheets("feuil2").Range("a3").Value <> "" Then
boucle = Sheets("feuil2").Range("a3").Value
Else
If Sheets("feuil2").Range("a4").Value <> "" Then
boucle = Sheets("feuil2").Range("a4").Value
Else
If Sheets("feuil2").Range("a4").Value <> "" Then
boucle = Sheets("feuil2").Range("a4").Value
End If
End If
End If
End If
End If
End Function

Merci de m'aider

8 réponses

  2.  Chris 94 Modérateur
    Salut,

    Faut le rendre quand ?
    1. pijaku Modérateur
      Salut Chris,

      Merci de ta visite.

      J'ai initialement pensé à effacer mes réponses, mais bon, ça peux toujours servir à quelqu'un, ne serait ce qu'à son prof...

      A+
    2. Chris 94 Modérateur
      ;-)
    3. titi
      Merci de ta visite tu n'as que ça a faire de ta journée, ce n'est pas a rendre, c'est pour améliorer mon travail au sein de mon entreprise

      Cordialement
    4. pijaku Modérateur
      c'est pour améliorer mon travail au sein de mon entreprise
      C'est pour cela que tu créées des sujets multiples lorsque tu as une réponse???
      C'est pour cela que tu ne dis mas merci lorsque le boulot t'arrives tout cuit dans le bec???

      Ma question : tu n'as que ça a faire de ta journée???
  3. pijaku Modérateur
    Peut être souhaites tu réaliser une fonction personnalisée qui fonctionne dans ta feuille, sans appel par VBA.
    Alors : 
    Function RegroupeEnA(Plage As Range, Ligne As Long)
Dim Tabl(), i As Long, Lig As Long
Dim PremLig As Long, DrLig As Long, Col As String

Col = Split(Plage.Address, "$")(1)
PremLig = Left(Split(Plage.Address, "$")(2), 1)
DrLig = Split(Plage.Address, "$")(4)
ReDim Tabl(DrLig - 1)
Lig = 0
For i = PremLig To DrLig
    If Range(Col & i).Value <> "" Then
        Tabl(Lig) = Range(Col & i).Value
        Lig = Lig + 1
    End If
Next
For i = LBound(Tabl) To UBound(Tabl)
    Debug.Print Tabl(i)
Next
RegroupeEnA = Tabl(Ligne)
End Function


    Et donc dans ta feuille, il suffit de saisir en A1 :

    =RegroupeEnA(B$1:B$100;LIGNE(A1)-1)

    et étirer cette formule vers le bas.
    Dès que tu vois un 0 tu as fini...
    1. pijaku Modérateur
      ça marche mais serai t'il possible plutot d'avoir
      Function RegroupeEnA(..................
      End Function

      J'ai envie de dire "Why Not?"...

      Après tout dépends de ce que tu veux mettre en paramètre de cette fonction...

      par exemple avec en paramètres :
      - TablB : variable tableau contenant les données de ta colonne "à trous" (ici Colonne B)
      - ColRestit : variable String contenant la lettre de la colonne de restitution des donénes (ici colonne A) 

      Sub Appel_Fonction_RegroupeEnA()
Dim TablB, ColRestit As String
'ici tu remplis la variable tableau avec les données de la colonne B
TablB = Range("B1", Range("B" & Rows.Count).End(xlUp))
'tu choisis ta colonne de restitution
ColRestit = "A"
'et tu appelles ta fonction
RegroupeEnA TablB, ColRestit
End Sub

Function RegroupeEnA(TablColB, Col As String)
Dim TablColA(), i As Long, Lig As Long

'ici commence le travail en mémoire...
For i = LBound(TablColB) To UBound(TablColB)
    If TablColB(i, 1) <> "" Then
        ReDim Preserve TablColA(Lig)
        TablColA(Lig) = TablColB(i, 1)
        Lig = Lig + 1
    End If
Next
'restitution
Range(Col & "1").Resize(UBound(TablColA), 1) = Application.Transpose(TablColA)
End Function


      What else?
      2. boc
        Merci Pijaku ça marche mais serai t'il possible plutot d'avoir
        Function RegroupeEnA(..................
        End Function
        1. pijaku Modérateur
          Bonjour tout le monde,

          Une version qui, en cas de moultes lignes, permettra d'accélerer le timing en utilisant des variables tableaux : 

          Sub RegroupeEnA() 
Dim TablColB, TablColA(), i As Long, Lig As Long 

TablColB = Range("B1", Range("B" & Rows.Count).End(xlUp)) 
'ici commence le travail en mémoire... 
For i = LBound(TablColB) To UBound(TablColB) 
    If TablColB(i, 1) <> "" Then 
        ReDim Preserve TablColA(Lig) 
        TablColA(Lig) = TablColB(i, 1) 
        Lig = Lig + 1 
    End If 
Next 
'restitution
Range("A1").Resize(UBound(TablColA), 1) = Application.Transpose(TablColA) 
End Sub

          Cordialement,
          Franck P
          1. Paf
            Bonjour,

            une autre solution qui copie les valeur de la colonne B dans la colonne A sans laisser de cellules vides: 

            Dim Derlig As Long, i As Long, j as Long      
Derlig = Range("B" & Rows.Count).End(xlUp).Row   
j=1
With  Sheets("feuil2")
For i= 1 To Derlig         
    If .Cells(i,2).Value <> " Then
         .Cells(j,1).Value= .Cells(i,2).Value
         j=j+1
    End If
Next i


            Bonne suite
            1. Utilisateur anonyme
              Bonjour,

              Exemple de boucle : 

              Sub Boucle()


    Dim Limite As Long, Boucle As Long
    
    ' Trouve la fin de la boucle
    Limite = ActiveSheet.Range("B65535").End(xlUp).Row
    
    Range("B1").Select
    
    For Boucle = 0 To Limite
        ' Si la cellule Bi est non vide (où i est représenté ici par Boucle)
        If (ActiveCell.Offset(Boucle, 0).Value <> "") Then
            ' Alors dans la cellule de gauche (Ai) affecte la valeur courante de Bi
            ActiveCell.Offset(Boucle, -1).Value = _
                ActiveCell.Offset(Boucle, 0).Value
        End If
    Next Boucle
    

End Sub


              Cdt

              Lupin
              1. bocman
                ça ne marche toujours pas
                , je ne comprends pas le tiret a la fin de " ActiveCell.Offset(Boucle, -1).Value = _"
              2. Utilisateur anonyme
                re:

                Le tiret veut dire [ continue avec la ligne suivante ]

                l'équivalent serait :

                ActiveCell.Offset(Boucle, -1).Value = ActiveCell.Offset(Boucle, 0).Value

                Cdt

                Lupin