[Débutant]Erreur compli et simplification code

Le 18/04/2018 à 16:36

Bonjour tout le monde,

Je viens vers vous pour un problème d'erreur dans une boucle et des conseils de structure

Sub crit_eval1(lettre, j)
Dim i As Byte

 For i = 1 To 100
  If Feuil1.Range("H" & i) = "4" And Feuil1.Range("H" & i) = lettre Then
   Feuil19.Range("A" & j, "B" & j).MergeCells = True
   Feuil19.Range("A" & j) = Feuil1.Range("B" & i)
   j = j + 1
  ElseIf Feuil1.Range("L" & i) = "4" And Feuil1.Range("H" & i) = lettre Then
   Feuil19.Range("A" & j, "B" & j).MergeCells = True
   Feuil19.Range("A" & j) = Feuil1.Range("B" & i)
   j = j + 1
  End If
 Next

End Sub

'rempli feuil19.colonne A
'avec lles crritères d'éval de feuil1.colonne A
Sub orga_criteval()

Dim j As Byte, nbA As Byte, nbB As Byte, nbC As Byte, nbD As Byte, nbE As Byte
Dim a As String, b As String, c As String, d As String, e As String

j = 5
a = "A"
b = "B"
c = "C"
d = "D"
e = "E"

nbA = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), a)
nbB = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), b)
nbC = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), c)
nbD = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), d)
nbE = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), e)

If Not (nbA = 0) Then
 Feuil19.Range("A" & j) = "Consignes et instructions"
 j = j + 1
 Call crit_eval1(a, j)

ElseIf Not (nbB = 0) Then
 Feuil19.Range("A" & j) = "Esprit d'équipe"
 j = j + 1
 For i = 1 To 100
 Call crit_eval1(b, j)

ElseIf Not (nbC = 0) Then
 Feuil19.Range("A" & j) = "Opérations"
 j = j + 1
 Call crit_eval1(c, j)

ElseIf Not (nbD = 0) Then
 Feuil19.Range("A" & j) = "Savoir être"
 j = j + 1
 Call crit_eval1(d, j)

ElseIf Not (nbE = 0) Then
 Feuil19.Range("A" & j) = "Savoir faire"
 j = j + 1
 Call crit_eval1(e, j)

End If

End Sub

Au bout du deuxième ElseIf *EsleIf not(nbC = 0) then*, j'ai l'erreur : Erreur de compilation Else sans if.

Comme j'écrivais toujours la même chose, j'ai copier-coller chaque ElseIf. J'ai essayé de mettre ce ElseIf en commentaire et l'erreur se met sur celui d'après. Donc j'ai tout réécrit, même résultat. J'ai tout recopier-coller, même résultat.

Voyez-vous quelle erreur j'ai faite ?

Aussi, si vous avez des conseils pour faire la même chose en simplifié, je suis preneuse sachant que je ne peux pas modifier les feuilles sources ci jointe (doc opératuer nv1 conf).

Ce que j'essaie de faire est de copier les critères d'évaluations de la feuille "opérateur niv 1"(Feuil1) du classeur du même nom dans la feuille "Matrice de compétences"(Feuil19) sous des titres selon qu'ils ont un A, un B, un C, un D ou un E sur la même ligne dans la colonne A dans Feuil1. Je suis obligé de passer par VBA vu que ce tableau doit se générer entièrement automatiquement (un bouton).

Le but final pour cette partie de mon programme (derniers sub dans le module) est de créer exactement la colonne A du fichier joint Matrice ref

Merci encore de me permettre de progresser grâce à vos conseils et réponses =D

Lucie

7matrice-ref.xlsx (30.39 Ko)
11operateur-niv1-conf.xlsm (201.89 Ko)
Le 18/04/2018 à 19:44

Bonsoir,

Dans un premier temps ce n'est pas une erreur de if... VBA manifeste seulement ainsi qu'il y a une erreur logique en l’occurrence ici c'est le Next de la boucle For qui manque...

Pour le reste il faut que j'étudie la pièce jointe... Je verrai cela dans un moment !

[EDIT]

Après avoir évalué la bête, je trouve que c'est pas mal...

La meilleure méthode étant celle qu'on maitrise le mieux... Je te suggère de laisser les choses en l'état.

C'est fluide. KESKE tu veux de plus ?

Bien sur on peut toujours trouver à améliorer, mais sur ce coup du point de vue du rapport investissement/résultat, si c'est toi qui a pondu ça : Je te vote un satisfecit !

Le 19/04/2018 à 09:48

Bonjour,

Merci galopin 01 =)

En effet ! le for de orga_criteval n'avait rien à faire là ^^

Du coup j'ai bidouillé un peu ma sub pour qu'elle tourne comme je le voulais et ça donne ça :

Sub couleur()
 Dim i As Byte, j As Byte, note As String

 For i = 1 To nbcol
  For j = 3 To nblign
   If (i = 1 Or i = 2) And j = 3 Then
    Feuil19.Cells(j, i).Interior.ColorIndex = 2
   Else
    note = Feuil19.Cells(j, i).Value
    Select Case (note)
     Case Is = 1
      Feuil19.Cells(j, i).Interior.ColorIndex = 3
     Case Is = 2
      Feuil19.Cells(j, i).Interior.ColorIndex = 6
     Case Is = 3
      Feuil19.Cells(j, i).Interior.ColorIndex = 43
     Case Is = 4
      Feuil19.Cells(j, i).Interior.ColorIndex = 10
     Case Is = "", " "
      Feuil19.Cells(j, i).Interior.ColorIndex = 24
    End Select
   End If
  Next j
 Next i

End Sub

Sub crit_eval1(lettre, j)
Dim i As Byte

 For i = 1 To 100
  If Feuil1.Range("H" & i) = "4" And Feuil1.Range("A" & i) = lettre Then
   Feuil19.Range("A" & j, "B" & j).MergeCells = True
   Feuil19.Range("A" & j) = Feuil1.Range("B" & i)
   j = j + 1
  ElseIf Feuil1.Range("L" & i) = "4" And Feuil1.Range("A" & i) = lettre Then
   Feuil19.Range("A" & j, "B" & j).MergeCells = True
   Feuil19.Range("A" & j) = Feuil1.Range("B" & i)
   j = j + 1
  End If
 Next i

End Sub

'rempli feuil19.colonne A
'avec lles crritères d'éval de feuil1.colonne A
Sub orga_criteval()

Dim j As Byte, nbA As Byte, nbB As Byte, nbC As Byte, nbD As Byte, nbE As Byte
Dim a As String, b As String, c As String, d As String, e As String

j = 4
a = "A"
b = "B"
c = "C"
d = "D"
e = "E"

nbA = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), a)
nbB = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), b)
nbC = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), c)
nbD = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), d)
nbE = Application.WorksheetFunction.CountIf(Feuil1.Range("A1:A90"), e)

If Not (nbA = 0) Then
 Feuil19.Range("A" & j) = "Consignes et instructions"
 Feuil19.Range("A" & j, "B" & j).MergeCells = True
 i = 1
  Do Until i = nbcol + 1
 Feuil19.Cells(j, i).Borders.Weight = xlThick
 i = i + 1
 Loop
 j = j + 1
 Call crit_eval1(a, j)
 End If

If Not (nbB = 0) Then
 Feuil19.Range("A" & j, "B" & j).MergeCells = True
 Feuil19.Range("A" & j) = "Esprit d'équipe"
 i = 1
  Do Until i = nbcol + 1
 Feuil19.Cells(j, i).Borders.Weight = xlThick
 i = i + 1
 Loop
 j = j + 1
 Call crit_eval1(b, j)
End If

If Not (nbC = 0) Then
 Feuil19.Range("A" & j, "B" & j).MergeCells = True
 Feuil19.Range("A" & j) = "Opérations"

 i = 1
  Do Until i = nbcol + 1
 Feuil19.Cells(j, i).Borders.Weight = xlThick
 i = i + 1
 Loop

 j = j + 1
 Call crit_eval1(c, j)
End If

If Not (nbD = 0) Then
 Feuil19.Range("A" & j, "B" & j).MergeCells = True
 Feuil19.Range("A" & j) = "Savoir être"
 i = 1
  Do Until i = nbcol + 1
 Feuil19.Cells(j, i).Borders.Weight = xlThick
 i = i + 1
 Loop
 j = j + 1
 Call crit_eval1(d, j)
End If

If Not (nbE = 0) Then
 Feuil19.Range("A" & j, "B" & j).MergeCells = True
 Feuil19.Range("A" & j) = "Savoir faire"
 i = 1
  Do Until i = nbcol + 1
 Feuil19.Cells(j, i).Borders.Weight = xlThick
 i = i + 1
 Loop

 j = j + 1
 Call crit_eval1(e, j)
End If

End Sub

Ca marche nickel =D,

Merci pour tes conseils galopin01 !

Rechercher des sujets similaires à "debutant erreur compli simplification code"