Problème vba avec IF

A

ascarter

XLDnaute Junior
Bonjour à tous, je tiens tout d'abord à dire que je suis débutant en VBA. J'espére que vous ne serez pas trop effrayé par l'écriture de mon programme. Mon probléme est le suivant, dans la paragraphe ('couleur) de mon programme, j'ai plusieurs fonction IF à la suite, sauf qu'il me prend en compte que le dernier. Je vous met en piéce jointes un fichier exemple qui devrait vous permettre de mieux comprendre mon problème.
Merci d'avance pour vos réponses.
 

Pièces jointes

  • Test .xls
    44 KB · Affichages: 64
  • Test .xls
    44 KB · Affichages: 75
  • Test .xls
    44 KB · Affichages: 77
Trier par date Trier par votes
A

ascarter

XLDnaute Junior
Re : Problème vba avec IF

Je viens d'assayer autre chose, mais sa ne marche toujours pas. J'ai remplacé le paragraphe 'couleur par ceci.

For Each Cellule In Sheets("Données").Range("F2:K200")
If Cellule.Font.ColorIndex = 3 Then
Sheets("Inventaire").Range("B2:B200").Interior.ColorIndex = 3
Else
Sheets("Inventaire").Range("B2:B200").Interior.ColorIndex = 6
End If
Next Cellule

Je suis bloqué,pouvez vous m'aider svp?merci d'avance
 
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : Problème vba avec IF

Bonjour,
Code: 
Sub choix_moteur()
Application.ScreenUpdating = False

'choix moteur
If Range("A3").Value = "Moteur1a" Then
Sheets("Inventaire").Range("B2:B200").Value = Sheets("Données").Range("F2:F200").Value
For i = 2 To 200
Select Case Sheets("Données").Cells(i, 6).Font.ColorIndex
Case Is = 3
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 3
Case Else
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 6
End Select
Next i

End If

If Range("A3").Value = "Moteur1b" Then
Sheets("Inventaire").Range("B2:B200").Value = Sheets("Données").Range("G2:G200").Value
For i = 2 To 200
Select Case Sheets("Données").Cells(i, 7).Font.ColorIndex
Case Is = 3
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 3
Case Else
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 6
End Select
Next i
End If

If Range("A3").Value = "Moteur1c" Then
Sheets("Inventaire").Range("B2:B200").Value = Sheets("Données").Range("H2:H200").Value
For i = 2 To 200
Select Case Sheets("Données").Cells(i, 8).Font.ColorIndex
Case Is = 3
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 3
Case Else
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 6
End Select
Next i
End If

If Range("A3").Value = "Moteur1d" Then
Sheets("Inventaire").Range("B2:B200").Value = Sheets("Données").Range("I2:I200").Value
For i = 2 To 200
Select Case Sheets("Données").Cells(i, 9).Font.ColorIndex
Case Is = 3
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 3
Case Else
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 6
End Select
Next i
End If

If Range("A3").Value = "Moteur2a" Then
Sheets("Inventaire").Range("B2:B200").Value = Sheets("Données").Range("J2:J200").Value
For i = 2 To 200
Select Case Sheets("Données").Cells(i, 10).Font.ColorIndex
Case Is = 3
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 3
Case Else
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 6
End Select
Next i
End If

If Range("A3").Value = "Moteur2b" Then
Sheets("Inventaire").Range("B2:B200").Value = Sheets("Données").Range("K2:K200").Value
For i = 2 To 200
Select Case Sheets("Données").Cells(i, 11).Font.ColorIndex
Case Is = 3
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 3
Case Else
Sheets("Inventaire").Cells(i, 2).Interior.ColorIndex = 6
End Select
Next i
End If

'coche
Dim Cellule As Range
Dim Forme As Object
On Error Resume Next
    For Each Forme In ActiveSheet.Shapes
        If Forme.Type = 8 Then
            Forme.Cut
        End If
    Next Forme
On Error GoTo 0
For Each Cellule In Range("B2:B200")
If Cellule <> "" Then
With Cellule
    .Select
    ActiveSheet.CheckBoxes.Add(.Left + 60, .Top, .Width, .Height).Select
    End With
With Selection
   .LinkedCell = Cellule.Offset(0, 1).Address
   .Characters.Text = ""
End With
End If
Next Cellule

'couleur


Application.ScreenUpdating = True

End Sub
je pense que ceci te conviendras.
Au plaisir.
 
Vote positif 0 Vote négatif
tototiti2008

tototiti2008

XLDnaute Barbatruc
Re : Problème vba avec IF

Bonjour à tous :)

Bon, j'ai fait un truc, je le poste ;)

Code: 
Dim Col As String
'choix moteur

    Select Case Range("A3").Value
    Case "Moteur1a"
        Col = "F"
    Case "Moteur1b"
        Col = "G"
    Case "Moteur1c"
        Col = "H"
    Case "Moteur1d"
        Col = "I"
    Case "Moteur2a"
        Col = "J"
    Case "Moteur2b"
        Col = "K"
    End Select
    Sheets("Inventaire").Range("B2:B200").Value = Sheets("Données").Range(Col & "2:" & Col & "200").Value

'couleur
    Sheets("Inventaire").Range("B2:B200").Interior.ColorIndex = xlNone
    With Sheets("Inventaire")
        For i = 2 To .Range("B65536").End(xlUp).Row
            If Sheets("Données").Range(Col & i).Font.ColorIndex = 3 Then
                .Cells(i, 2).Interior.ColorIndex = 3
            Else
                .Cells(i, 2).Interior.ColorIndex = 6
            End If
        Next i
    End With
'coche
Dim Cellule As Range
Dim Forme As Shape
On Error Resume Next
    For Each Forme In ActiveSheet.Shapes
        If Forme.Type = 8 Then
            If Forme.FormControlType = xlCheckBox Then Forme.Delete
        End If
    Next Forme
On Error GoTo 0
For Each Cellule In Range("B2:B200")
If Cellule <> "" Then
With Cellule
    .Select
    ActiveSheet.CheckBoxes.Add(.Left + 60, .Top, .Width, .Height).Select
    End With
With Selection
   .LinkedCell = Cellule.Offset(0, 1).Address
   .Characters.Text = ""
End With
End If
Next Cellule
End Sub
 
Vote positif 0 Vote négatif
A

ascarter

XLDnaute Junior
Re : Problème vba avec IF

Merci fhoest et mécano41, c'est exactement ce que je voulais. Par contre est-il possible que dans la feuille Inventaire,colonne B, quand il n'y a pas de texte dans une cellule, la cellule reste avec un fond blanc?
Merci beaucoup, vous me sortez une grosse épine du pied les gars!!
 
Vote positif 0 Vote négatif
fhoest

fhoest

XLDnaute Accro
Re : Problème vba avec IF

Bonjour mecano41 & tototiti,
Je viens de revenir et pour ma part je choisirai entre le code de mécano41 et Tototiti car ils ont mieux gérer l'optimisation du code avec le fait de ne pas répéter celui ci a plusieurs reprise,soit ce n'est que mon avis ,une petite préférence pour un sub détaché comme la si bien fait notre amie mécano pour pouvoir l'appeler indépendamment

A+ et bonne continuation.
 
Vote positif 0 Vote négatif

Discussions similaires

J
  • Résolu(e)
XL 2021 plantage lors d'un export format PDF
Réponses
14
Affichages
379
JPaul78
J
E
  • Question
XL 2013 Excel VBA - Problème lien hypertexte pour ouvrir un dossier
2
Réponses
19
Affichages
840
TooFatBoy
TooFatBoy
CGU2022.
  • Résolu(e)
XL 2013 Mise en forme conditionelle Problème avec cellule qui contient une formule
Réponses
3
Affichages
210
Gégé-45550
Gégé-45550
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
281
fanch55
fanch55
A
  • Résolu(e)
Microsoft 365 Formule avec 2 conditions
Réponses
8
Affichages
328
AD95
A
D
  • Question
XL pour MAC [RESOLU]Cacher ou afficher colonnes, sauf colonne selectionné
Réponses
9
Affichages
647
Dudy
D
J
  • Question
XL 2016 Problème de formulaire, checkbox dynamiques
Réponses
12
Affichages
351
Jingxi
J
Z
  • Résolu(e)
Microsoft 365 Problème de combinaison entre fonctions "If Then Else" et "SelectCase"
Réponses
11
Affichages
310
Zonmé
Z
M
  • Question
Microsoft 365 Copier / coller avec mise en forme VBA
Réponses
0
Affichages
205
marie3107
M
L
  • Résolu(e)
XL 2016 Problème incrémentation n° encodage avec séparateur type "tiret"
Réponses
7
Affichages
400
Phil69970
Phil69970

Membres actuellement en ligne

4 membres et 62 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 520
Messages
2 089 301
Membres
104 092
dernier inscrit
karbone57