Simplifier un select case

Créer une discussion
Répondre
  • Initiateur de la discussion Initiateur de la discussion mroma
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
M

mroma

Guest
bonjour à tous,

Je me permets de vous poser une nouvelle question sur ce superbe forum 😉

Alors voila, je souhaite simplifier mon Select case

Code: 
            Select Case Cel.Offset(0, -1)
              Case Is = "AFCE"
                  If Kase.Offset(0, 8) = "IFCE" Or Kase.Offset(0, 8) = "IFC1E" Or Kase.Offset(0, 8) = "IFC2E" _
                    Or Kase.Offset(0, 8) = "IFC3E" Or Kase.Offset(0, 8) = "IFC4E" Or Kase.Offset(0, 8) = "IFC5E" Then
                      Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
                      Kase.Offset(0, 8).Font.Color = vbBlack
                  Else
                      Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
                      Kase.Offset(0, 8).Font.Color = vbBlack
                      .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                      Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
                  End If
                
              Case Is = "AFDE"
                  If Kase.Offset(0, 8) = "IDDE" Or Kase.Offset(0, 8) = "IDD1E" Or Kase.Offset(0, 8) = "IDD2E" Or Kase.Offset(0, 8) = "IFDE" Then
                    Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
                    Kase.Offset(0, 8).Font.Color = vbBlack
                  Else
                    Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
                    Kase.Offset(0, 8).Font.Color = vbBlack
                    .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                    Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
                 End If
                  
              Case Is = "IFRE"
                  If Kase.Offset(0, 8) = "IFAE" Or Kase.Offset(0, 8) = "IFRE" Or Kase.Offset(0, 8) = "IFR1" Or Kase.Offset(0, 8) = "IFR2" Then
                    Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
                    Kase.Offset(0, 8).Font.Color = vbBlack
                  Else
                    Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
                    Kase.Offset(0, 8).Font.Color = vbBlack
                    .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                    Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
                 End If
             End Select

Merci !! 😉😀
 
Trier par date Trier par votes
Re : Simplifier un select case

Bonjour Mroma, bonjour le forum,

Je vois mal comment simplifier ton code si ce n'est en utilisant un second Select Case. Par contre, comment le rendre plus lisible ça oui :
Code: 
Select Case Cel.Offset(0, -1)
    Case Is = "AFCE"
        If Kase.Offset(0, 8) = "IFCE" Or Kase.Offset(0, 8) = "IFC1E" Or Kase.Offset(0, 8) = "IFC2E" _
        Or Kase.Offset(0, 8) = "IFC3E" Or Kase.Offset(0, 8) = "IFC4E" Or Kase.Offset(0, 8) = "IFC5E" Then
            Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
            Kase.Offset(0, 8).Font.Color = vbBlack
        Else
            Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
            Kase.Offset(0, 8).Font.Color = vbBlack
            .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
        End If

    Case Is = "AFDE"
        If Kase.Offset(0, 8) = "IDDE" Or Kase.Offset(0, 8) = "IDD1E" Or Kase.Offset(0, 8) = "IDD2E" Or Kase.Offset(0, 8) = "IFDE" Then
            Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
            Kase.Offset(0, 8).Font.Color = vbBlack
        Else
            Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
            Kase.Offset(0, 8).Font.Color = vbBlack
            .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
        End If

    Case Is = "IFRE"
        If Kase.Offset(0, 8) = "IFAE" Or Kase.Offset(0, 8) = "IFRE" Or Kase.Offset(0, 8) = "IFR1" Or Kase.Offset(0, 8) = "IFR2" Then
            Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
            Kase.Offset(0, 8).Font.Color = vbBlack
        Else
            Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
            Kase.Offset(0, 8).Font.Color = vbBlack
            .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
            Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
        End If
End Select

Avec le second End Select :
Code: 
Select Case Cel.Offset(0, -1)
    Case Is = "AFCE"
        Select Case Kase.Offset(0, 8).Value
            Case "IFCE", "IFC1E", "IFC2E", "IFC3E", "IFC4E", "IFC5E"
                Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
                Kase.Offset(0, 8).Font.Color = vbBlack
            Case Else
                Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
                Kase.Offset(0, 8).Font.Color = vbBlack
                .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
        End Select
    Case Is = "AFDE"
        Select Case Kase.Offset(0, 8).Value
            Case "IDDE", "IDD1E", "IDD2E", "IFDE"
                Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
                Kase.Offset(0, 8).Font.Color = vbBlack
            Case Else
                Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
                Kase.Offset(0, 8).Font.Color = vbBlack
                .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
        End Select
    Case Is = "IFRE"
        Select Case Kase.Offset(0, 8).Value
            Case "IFAE", "IFRE", "IFR1E", "IFRE2"
                Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
                Kase.Offset(0, 8).Font.Color = vbBlack
            Case Else
                Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
                Kase.Offset(0, 8).Font.Color = vbBlack
                .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
                Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit
        End Select
End Select
 
Vote positif 0 Vote négatif
Re : Simplifier un select case

Rebonjour.

Je verrais quand même bien quelque chose comme ça :
VB: 
Dim Lst2 As String
Select Case Cel.Offset(0, -1)
    Case Is = "AFCE": Lst2 = "IFCE|IFC1E|IFC2E|IFC3E|IFC4E|IFC5E"
    Case Is = "AFDE": Lst2 = "IDDE|IDD1E|IDD2E|IFDE"
    Case Is = "IFRE": Lst2 = "IFCE|IFC1E|IFC2E|IFC3E|IFC4E|IFC5E"
    Case Else:        Lst2 = "…": End Select
If Lst2 <> "…" Then
   Kase.Offset(0, 8).Font.Color = vbBlack
   If InStr(Lst2, Kase.Offset(0, 8).Value) Then
      Kase.Offset(0, 8).Interior.ColorIndex = 10  ' Vert
   Else
      Kase.Offset(0, 8).Interior.ColorIndex = 3  ' Rouge
      .Rows(Kase.Row).Copy Sheets("Error on the MSCode").Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
      Sheets("Error on the MSCode").Columns("A:U").Columns.AutoFit: End If: End If
 
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Assurez vous de marquer un message comme solution pour une meilleure transparence.

Discussions similaires

U
  • Question Question
Autres [RÉSOLU] macro à modifier
Réponses
1
Affichages
592
un internaute
U
F
  • Question Question
Microsoft 365 Problème mémoire insuffisante
Réponses
5
Affichages
846
TooFatBoy
TooFatBoy
L
  • Question Question
Microsoft 365 Erreur automation 440 sur code VBA
Réponses
1
Affichages
373
job75
job75
T
  • Résolu(e)
Microsoft 365 VBA Exporter une sélection de plages nommées au format PDF
Réponses
12
Affichages
1 K
tnion
T
M
  • Question Question
XL 2021 macro VBA
Réponses
4
Affichages
550
ManuEven
M
VBA_dev_Anne_Marie
  • Question Question
Microsoft 365 VBA : copier les adresses
Réponses
7
Affichages
976
VBA_dev_Anne_Marie
VBA_dev_Anne_Marie
A
  • Question Question
VBA qui fonctionnait avant, mais ne fonctionne plus avec le 64 bits
Réponses
2
Affichages
702
patricktoulon
patricktoulon
cathodique
  • Résolu(e)
XL 2010 Masque de saisie textbox Téléphone Public
Réponses
8
Affichages
1 K
cathodique
cathodique
A
  • Question Question
insertion d'une ligne automatique dans un tableau excel.
Réponses
1
Affichages
777
sylvanu
sylvanu
M
  • Question Question
XL 2016 Impression d'un rapport PDF depuis une URL avec VBA
Réponses
3
Affichages
1 K
mrcooll
M
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA - V1.05 - Evolutions majeures exports CSV, XML, XML UTF-8, JSON, HTML, PDF, JPG, JPEG, BMP, EXCEL
Réponses
10
Affichages
1 K
oguruma
oguruma
oguruma
EXCEL :: Les Tableaux Structurés :: Une classe VBA pour mieux les gérer - V1.02
Réponses
4
Affichages
844
bsalv
B
mromain
Génération de QR Codes
Réponses
9
Affichages
2 K
Rheeem
R
J
  • Question Question
Microsoft 365 macro qui ouvre des fichiers excel de type "analyze in excel" généré par power bi et met à jour un filtre "mois" sur plusieurs tcd
Réponses
0
Affichages
621
JJ69
J
Nicolas JACQUIN
  • Question Question
XL 2021 Exportation feuille msgbox yes no avec module Thisworkbook
2
Réponses
21
Affichages
2 K
Nicolas JACQUIN
Nicolas JACQUIN
N
  • Résolu(e)
Microsoft 365 Transfère de données d'un Userform vers un tableau structuré d'une feuille de calcul
Réponses
4
Affichages
478
NONO14
N
B
  • Résolu(e)
Microsoft 365 Besoin d'aide pour faire fonctionner 2 codes VBA ensemble
Réponses
2
Affichages
470
BenExcel
B
F
  • Question Question
XL 2016 copier des fichiers dans des sous dossiers a partir de case a cocher sous excel
2
Réponses
17
Affichages
2 K
Felipe54
F
U
  • Question Question
Autres [RÉSOLU] Faire afficher ligne sur tout le classeur par double clic et la faire maquer à l’enregistrement
Réponses
11
Affichages
1 K
un internaute
U
A
  • Question Question
XL 2016 Combobox Saisie Date
Réponses
12
Affichages
1 K
aurelio.ewane
A
Retour