VBA créer une boucle ??? [Résolu/Fermé]

Signaler
-
 titi -
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


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
ça ne marche toujours pas
, je ne comprends pas le tiret a la fin de " ActiveCell.Offset(Boucle, -1).Value = _"
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
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
Messages postés
12186
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 octobre 2020
2 518
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
Merci Pijaku ça marche mais serai t'il possible plutot d'avoir
Function RegroupeEnA(..................
End Function
Messages postés
12186
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 octobre 2020
2 518
ç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?
Messages postés
12186
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 octobre 2020
2 518
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...
Messages postés
49369
Date d'inscription
mardi 8 janvier 2008
Statut
Modérateur
Dernière intervention
26 novembre 2020
6 486
Salut,

Faut le rendre quand ?
Messages postés
12186
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 octobre 2020
2 518
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+
Messages postés
49369
Date d'inscription
mardi 8 janvier 2008
Statut
Modérateur
Dernière intervention
26 novembre 2020
6 486
;-)
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
Messages postés
12186
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 octobre 2020
2 518
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???
Messages postés
49369
Date d'inscription
mardi 8 janvier 2008
Statut
Modérateur
Dernière intervention
26 novembre 2020
6 486
Il n'y pas de quoi... Et vous êtes nombreux à améliorer votre travail au sein de l'entreprise ?
dsl pijaku le message n'était pas pour toi