Excel : fonction/code pour sauter une étape

Question

Bonjour, 

Tout d'abord, je dois vous dire que je suis pas très doué en programmation. Les seuls cours que j'ai eu, c'est en première année de fac, il y a plus de 10 ans et c'était du Turbo Pascal !
J'ai donc demandé à un copain pour me faire une macro sur Excel pour notamment afficher des trucs qui se trouvent dans des colonnes pour les mettre les unes après les autres avec des valeurs dans une colonne. Voilà ce que çà donne par exemple : 

 Next
    s = Left(s, Len(s) - 2)

    s = s & Chr(13) & Chr(10)
    
    index(14) = Len(s) + 1
    s = s & Worksheets("Feuil1").Range("C419") & " : "
    longueur(14) = Len(Worksheets("Feuil1").Range("C419"))
    For nbcell = 420 To 559
        If Worksheets("Feuil1").Range("C" & nbcell) = "X" Then
            s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
        ElseIf Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
            s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
        End If

J'arrive à peu près à comprendre le codage. En gros on écrit d'abord le titre qui se trouve en C419 puis la macro balaie la colonne C, s'il y a un X, alors on écrit la valeur qui se trouve sur la même ligne dans la colonne B, s'il y autre chose, alors on écrit ce qu'il y a en B sur la même ligne mais aussi ce qu'il y a en C.

Le truc c'est que parfois, aucune des cases de C420 à C559 n'est remplie. Ce que je voudrai donc apporter (mon copain est surbooké en ce moment, il peut pas trop m'aider) c'est une fonction juste avant qui si il n'y a absolument rien entre C420 et C559, alors l'étape que je viens de vous donner soit tout simplement "sauter" parce que sinon en ce moment, je me retrouve avec un titre et ":" mais rien derrière, donc je dois supprimer à la main tous les titres à chaque fois concernés.

Voilà pour mon problème. Quelqu'un peut-il m'aider ?

Cordialement
Calenloth

Configuration: Windows 7 / Firefox 13.0.1

eriiic · Accepted Answer

Bonsoir,

If WorksheetFunction.CountA([C420:C559]) > 0 Then
    ' ton code
End If
WorksheetFunction.CountA([C420:C559]) va compter le nombre de valeurs dans la plage C420:C559.
S'il y en a au moins 1 tu exécutes ton code.

eric

Paf · Answer

bonjour,

dans le principe il faudrait isoler le titre et l'inscrire dans la variable "s" dans la boucle, et en rajoutant, si cells("B"&...)="" alors s=""mais comme le code fourni n'est pas complet, pas évident de modifier sans savoir les conséquences .
A+

Calenloth · Answer

Je voulais pas mettre le gros pavé mais si çà peut faire avancer le schmilblick....

Sub MEF()

Dim index(22) As Integer
Dim longueur(22) As Integer
Dim s As Range

Set s = Worksheets("Feuil2").Range("A1")

'Vide la cellule cible
s = ""
s.Font.Bold = False

index(0) = Len(s) + 1
s = Worksheets("Feuil1").Range("C1")
longueur(0) = Len(Worksheets("Feuil1").Range("C1"))

s = s & Chr(13) & Chr(10)
s = s & Chr(13) & Chr(10)

index(1) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("B2") & " : " & Worksheets("Feuil1").Range("C2") & " PC"
longueur(1) = Len(Worksheets("Feuil1").Range("B2"))

s = s & Chr(13) & Chr(10)

index(2) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("B3") & " : "
longueur(2) = Len(Worksheets("Feuil1").Range("B3"))
Dim nbcell
For nbcell = 4 To 11
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(3) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("B14") & " : "
longueur(3) = Len(Worksheets("Feuil1").Range("B14"))
For nbcell = 15 To 19
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(4) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("B21") & " " & Worksheets("Feuil1").Range("C21") & " : "
longueur(4) = Len(Worksheets("Feuil1").Range("B21") & " " & Worksheets("Feuil1").Range("C21"))
For nbcell = 22 To 248
If Worksheets("Feuil1").Range("C" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(5) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("B21") & " " & Worksheets("Feuil1").Range("D21") & " : "
longueur(5) = Len(Worksheets("Feuil1").Range("B21") & " " & Worksheets("Feuil1").Range("D21"))
For nbcell = 22 To 248
If Worksheets("Feuil1").Range("D" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("D" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("D" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(6) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("B21") & " " & Worksheets("Feuil1").Range("E21") & " : "
longueur(6) = Len(Worksheets("Feuil1").Range("B21") & " " & Worksheets("Feuil1").Range("E21"))
For nbcell = 22 To 248
If Worksheets("Feuil1").Range("E" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("E" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("E" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(7) = Len(s) + 1
s = s & "Aptitudes de Combat : "
longueur(7) = Len("Aptitudes de Combat")
For nbcell = 250 To 276
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(8) = Len(s) + 1
s = s & "Aptitudes Physiques : "
longueur(8) = Len("Aptitudes Physiques")
For nbcell = 278 To 295
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(9) = Len(s) + 1
s = s & "Aptitudes Sociales : "
longueur(9) = Len("Aptitudes Sociales")
For nbcell = 297 To 306
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(10) = Len(s) + 1
s = s & "Aptitudes de Survie : "
longueur(10) = Len("Aptitudes de Survie")
For nbcell = 308 To 314
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(11) = Len(s) + 1
s = s & "Aptitudes de Connaissances : "
longueur(11) = Len("Aptitudes de Connaissances")
For nbcell = 316 To 338
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(12) = Len(s) + 1
s = s & "Langues et Alphabets : "
longueur(12) = Len("Langues et Alphabets")
For nbcell = 340 To 369
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(13) = Len(s) + 1
s = s & "Aptitudes Artisanales : "
longueur(13) = Len("Aptitudes Artisanales")
For nbcell = 371 To 417
If Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(14) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("C419") & " : "
longueur(14) = Len(Worksheets("Feuil1").Range("C419"))
For nbcell = 420 To 559
If Worksheets("Feuil1").Range("C" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(15) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("D419") & " : "
longueur(15) = Len(Worksheets("Feuil1").Range("D419"))
For nbcell = 420 To 559
If Worksheets("Feuil1").Range("D" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("D" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("D" & nbcell) & ", "
End If
Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(16) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("E419") & " : "
longueur(16) = Len(Worksheets("Feuil1").Range("D419"))
For nbcell = 420 To 559
If Worksheets("Feuil1").Range("E" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("E" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("E" & nbcell) & ", "

End If

Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(17) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("C561") & " : " & Worksheets("Feuil1").Range("C562") & " "
longueur(17) = Len(Worksheets("Feuil1").Range("C561"))
For nbcell = 563 To 601
If Worksheets("Feuil1").Range("C" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If

Next
s = Left(s, Len(s) - 2)

index(18) = Len(s) + 1
s = s & " " & Worksheets("Feuil1").Range("C602") & " "
longueur(18) = Len(Worksheets("Feuil1").Range("C561"))
For nbcell = 603 To 674
If Worksheets("Feuil1").Range("C" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("D" & nbcell) & ", "
End If

Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(19) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("D561") & " : " & Worksheets("Feuil1").Range("D562") & " "
longueur(19) = Len(Worksheets("Feuil1").Range("D561"))
For nbcell = 563 To 601
If Worksheets("Feuil1").Range("D" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("D" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("D" & nbcell) & ", "
End If

Next
s = Left(s, Len(s) - 2)

index(20) = Len(s) + 1
s = s & " " & Worksheets("Feuil1").Range("D602") & " "
longueur(20) = Len(Worksheets("Feuil1").Range("D561"))
For nbcell = 603 To 674
If Worksheets("Feuil1").Range("D" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("D" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("D" & nbcell) & ", "
End If

Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(21) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("E6") & Worksheets("Feuil1").Range("F6") & "."
longueur(21) = Len(Worksheets("Feuil1").Range("E6"))

s = s & Chr(13) & Chr(10)

index(22) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("E7") & Worksheets("Feuil1").Range("F7") & "."
longueur(22) = Len(Worksheets("Feuil1").Range("E7"))

For i = 0 To UBound(index) - 1
s.Characters(index(i), longueur(i)).Font.Bold = True
Next

End Sub

Voili voilou

Paf · Answer

re,

N'ayant pas tout compris sur la gestion de la variable "s", je ne m'aventurerait pas sur ma suggestion précédente.
Cette proposition répond à la demande:

une fonction juste avant qui si il n'y a absolument rien entre C420 et C559, alors l'étape que je viens de vous donner soit tout simplement "sauter"

Les lignes rajoutées sont en gras.

Dim i as Integer
Dim compt as Integer
compt=0
for i = 420 to 559
If Worksheets("Feuil1").Range("C" & i) <> "" Then
    compt=compt+1
End If
if compt > 0 then
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)
index(14) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("C419") & " : "
longueur(14) = Len(Worksheets("Feuil1").Range("C419"))
For nbcell = 420 To 559
If Worksheets("Feuil1").Range("C" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("C" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("C" & nbcell) & ", "
End If
Next 
End If

Mais, pas sûr que cela ne provoque pas d'erreur dans la boucle en fin de programme pour la mise en gras puisque index(14) et longueur(14) seront vides si aucune cellule entre C420 et C559 n'est renseignée.

Je ne veux pas recréer un jeu de données pour tester !!

Bonne suite

Calenloth · Answer

çà bug un peu, il y a un truc que je dois pas bien faire.

Avant j'avais :

Next
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(16) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("E419") & " : "
longueur(16) = Len(Worksheets("Feuil1").Range("E419"))
For nbcell = 420 To 559
If Worksheets("Feuil1").Range("E" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("E" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("E" & nbcell) & ", "

End If

Et maintenant j'ai écrit :
Next
If WorksheetFunction.CountA([E420:E559]) > 0 Then
s = Left(s, Len(s) - 2)

s = s & Chr(13) & Chr(10)

index(16) = Len(s) + 1
s = s & Worksheets("Feuil1").Range("E419") & " : "
longueur(16) = Len(Worksheets("Feuil1").Range("E419"))
For nbcell = 420 To 559
If Worksheets("Feuil1").Range("E" & nbcell) = "X" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", "
ElseIf Worksheets("Feuil1").Range("E" & nbcell) <> "" Then
s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("E" & nbcell) & ", "

End If
End If

Où est l'erreur svp ? Désolé j'ai l'impression d'être nul sur ce coup là de pas voir le problème. Pour info, çà me dit : "Erreur de compilation, End If sans Bloc If" pourtant j'ai bien mis deux "If"

Merci d'avance
Calen

eriiic · Answer

Bonsoir, 

Tu devrais prendre l'habitude d'indenter ton code sur les tests et les boucles, c'est plus facile de voir ses erreurs (les if sont alignés avec les endif, les for avec les next, etc). 
Le next du début n'a rien à voir avec la suite (c'est la fin d'un for qui se situe avant. 

Au niveau structure Il te manquait un next nbcell. 
If WorksheetFunction.CountA([E420:E559]) > 0 Then 
    s = Left(s, Len(s) - 2) 
    s = s & Chr(13) & Chr(10) 

    Index(16) = Len(s) + 1 
    s = s & Worksheets("Feuil1").Range("E419") & " : " 
    longueur(16) = Len(Worksheets("Feuil1").Range("E419")) 
    For nbcell = 420 To 559 
        If Worksheets("Feuil1").Range("E" & nbcell) = "X" Then 
            s = s & Worksheets("Feuil1").Range("B" & nbcell) & ", " 
        ElseIf Worksheets("Feuil1").Range("E" & nbcell) <> "" Then 
            s = s & Worksheets("Feuil1").Range("B" & nbcell) & " " & Worksheets("Feuil1").Range("E" & nbcell) & ", " 
        End If 
    Next nbcell 
End If 


eric

Excel : fonction/code pour sauter une étape

6 réponses

Newsletters