VBA si imbriqués et boucle
juju
-
pou pouille Messages postés 212 Statut Membre -
pou pouille Messages postés 212 Statut Membre -
Bonjour,
VBA quand tu nous tiens ... help me please !!
Je voudrais que cette macro se réalise pour toutes les cellules d'une même ligne, en d'autre terme je souhaite faire une boucle de manière à traiter chaque cellule de la ligne B.
Mon second problème qui en fait est le premier... est que je ne crois pas que mes Si soit imbriqués...
Sub copie_smileys()
'sur la ligne 1 se trouve mes smileys en wingdings
If B3 = B2 Then
Range("C1").Select
Selection.Copy
Range("B4").Select
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
If B3 > B2 Then
Range("E1").Select
Selection.Copy
Range("B4").Select
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
If B3 < B2 Then
Range("A1").Select
Selection.Copy
Range("B4").Select
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
End If
End If
End If
'cette partie ne fait que mettre en forme mes cellule comme je le souhaite avec la bonne police et la bonne taille...
With Selection.Font
.Name = "Wingdings"
.FontStyle = "Normal"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'je veux faire ma boucle a partir d'ici comment faire...????
End Sub
Merci bcp pour votre aide peut etre que je vais pouvoir finir un projet qui me prend depuis un certains temps....!!!
:)
VBA quand tu nous tiens ... help me please !!
Je voudrais que cette macro se réalise pour toutes les cellules d'une même ligne, en d'autre terme je souhaite faire une boucle de manière à traiter chaque cellule de la ligne B.
Mon second problème qui en fait est le premier... est que je ne crois pas que mes Si soit imbriqués...
Sub copie_smileys()
'sur la ligne 1 se trouve mes smileys en wingdings
If B3 = B2 Then
Range("C1").Select
Selection.Copy
Range("B4").Select
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
If B3 > B2 Then
Range("E1").Select
Selection.Copy
Range("B4").Select
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
If B3 < B2 Then
Range("A1").Select
Selection.Copy
Range("B4").Select
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
End If
End If
End If
'cette partie ne fait que mettre en forme mes cellule comme je le souhaite avec la bonne police et la bonne taille...
With Selection.Font
.Name = "Wingdings"
.FontStyle = "Normal"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'je veux faire ma boucle a partir d'ici comment faire...????
End Sub
Merci bcp pour votre aide peut etre que je vais pouvoir finir un projet qui me prend depuis un certains temps....!!!
:)
2 réponses
alors je suis pas un expert mais je pense que qqch comme cela devrai fonctionner:
dim ligne as variant
dim i as variant 'donne le nom que tu veut à tes variables
for i=1 to 65536 '65536 c'est la fin du tableau
'opérations à effectuer
ligne=ligne+1 'permet de passer à la ligne suivante
loop
(attention du doit remplacer les range("Bx") par range("B" & ligne) )
dim ligne as variant
dim i as variant 'donne le nom que tu veut à tes variables
for i=1 to 65536 '65536 c'est la fin du tableau
'opérations à effectuer
ligne=ligne+1 'permet de passer à la ligne suivante
loop
(attention du doit remplacer les range("Bx") par range("B" & ligne) )
Sub création_des_smileys()
'copie les smileys en fonction de l'objectif
Dim ligne, ligne2, ligne3, ligne4 As Variant
Dim i As Variant 'donne le nom que tu veux à tes variables
ligne = 1
ligne2 = ligne + 1
ligne3 = ligne2 + 1
ligne4 = ligne3 + 1
If Range("B" & ligne2) = Range("B" & ligne3) Then
Range("C" & ligne).Select
Selection.Copy
Range("B" & ligne4).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
Else
If B & ligne3 > B & ligne2 Then
Range("E" & ligne).Select
Selection.Copy
Range("B" & ligne4).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
Else
If B & ligne3 < B & ligne2 Then
Range("A" & ligne).Select
Selection.Copy
Range("B" & ligne4).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
End If
End If
End If
With Selection.Font
.Name = "Wingdings"
.FontStyle = "Normal"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'For i = 1 To 65536 '65536 c'est la fin du tableau
'opérations à effectuer
'ligne = ligne + 1 'permet de passer à la ligne suivante
'Loop
End Sub
dit moi si ca fonctionne comme tu veut pour une ligne ?
'copie les smileys en fonction de l'objectif
Dim ligne, ligne2, ligne3, ligne4 As Variant
Dim i As Variant 'donne le nom que tu veux à tes variables
ligne = 1
ligne2 = ligne + 1
ligne3 = ligne2 + 1
ligne4 = ligne3 + 1
If Range("B" & ligne2) = Range("B" & ligne3) Then
Range("C" & ligne).Select
Selection.Copy
Range("B" & ligne4).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
Else
If B & ligne3 > B & ligne2 Then
Range("E" & ligne).Select
Selection.Copy
Range("B" & ligne4).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
Else
If B & ligne3 < B & ligne2 Then
Range("A" & ligne).Select
Selection.Copy
Range("B" & ligne4).Select
Selection.PasteSpecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
End If
End If
End If
With Selection.Font
.Name = "Wingdings"
.FontStyle = "Normal"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
'For i = 1 To 65536 '65536 c'est la fin du tableau
'opérations à effectuer
'ligne = ligne + 1 'permet de passer à la ligne suivante
'Loop
End Sub
dit moi si ca fonctionne comme tu veut pour une ligne ?
je galère mais vraiment je galère...
si tu as compris ce que je veux faire regarde a nouveau mon code et sache que ca ne marche pas ce qui n'est pas compliqué a voir... :(
Sub création_des_smileys()
'copie les smileys en fonction de l'objectif
Dim ligne As Variant
Dim i As Variant 'donne le nom que tu veux à tes variables
If Range("B" & ligne) = Range("B" & ligne) Then
Range("C1").Select
Selection.Copy
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
Else
If B3 > B2 Then
Range("E1").Select
Selection.Copy
Range("B4").Select
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
Else
If B3 < B2 Then
Range("A1").Select
Selection.Copy
Range("B4").Select
Selection.pastespecial Paste:=xlPasteAllExceptBorders, Operation:=xlNone, _
SkipBlanks:=True, Transpose:=True
End If
End If
End If
With Selection.Font
.Name = "Wingdings"
.FontStyle = "Normal"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
For i = 1 To 65536 '65536 c'est la fin du tableau
'opérations à effectuer
ligne = ligne + 1 'permet de passer à la ligne suivante
Loop
End Sub