Excel : fonction/code pour sauter une étape
Calenloth
-
Calenloth -
Calenloth -
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
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
A voir également:
- Excel : fonction/code pour sauter une étape
- Liste déroulante excel - Guide
- Word et excel gratuit - Guide
- Si ou excel - Guide
- Déplacer colonne excel - Guide
- Excel trier par ordre croissant chiffre - Guide
6 réponses
Bonsoir,
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
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
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.
eric
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
bonjour,
dans le principe il faudrait isoler le titre et l'inscrire dans la variable "s" dans la boucle, et en rajoutant,
A+
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+
çà 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
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
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
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
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:
Les lignes rajoutées sont en gras.
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
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
Cordialement
Calenloth