Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 scinder une formule vba

D

Did25

XLDnaute Occasionnel
Bonsoir je recherche une solution pour scinder une formule plutôt longue mais nécessaire ,merci de bien vouloir m'aider

Private Sub CommandButton7_Click()
Range("D434,J4:J34,M4:M34,P434,S4:S34,V4:V34,Y4:Y34,AB4:AB34,AE4:AE34,AH4:AH34,AK4:AK34) _
and (AN4:AN34,AQ4:AQ34,AT4:AT34,AW4:AW34,AZ4:AZ34,AC4:BC34,BI4:BI34,BL4:BL34,BO4:BO34) _
and (BR4:BR34,BU4:BU34,BX4:BX34,CA4:CA34,CD4:CD34,CG4:CG34,CM4:CM34,CP4:CP34,CS4:CS34,CV4:CV34,CY4:CY34) _
and (ME4:ME34,MH4:MH34,MK4:MK34,MN4:MN34,MQ4:MQ34,MT4:MT34,MW4:MW34 ).ClearContents"

End Sub
 
Solution
Trier par date Trier par votes

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Bonjour Didier, le forum
une solution avec une boucle sur un tableau.
j'ai mis à part la seule range multi colonne AC4:BC34.
Cordialement
VB: 
Private Sub CommandButton7_Click()
Dim Address_en_Cours$
Application.Calculation = xlCalculationManual
For Each Address_en_Cours In Array("D4", "J4", "M4", "P4", "S4", "V4", "Y4", _
                                "AB4", "AE4", "AH4", "AK4", "AN4", "AQ4", "AT4", "AW4", "AZ4", _
                                "BI4", "BL4", "BO4", "BR4", "BU4", "BX4", _
                                "CA4", "CD4", "CG4", "CM4", "CP4", "CS4", "CV4", "CY4", _
                                "ME4", "MH4", "MK4", "MN4", "MQ4", "MT4", "MW4")
    Range(Address_en_Cours).Range("A1:A31").ClearContents
Next Address_en_Cours
Range("AC4:BC34").ClearContents
Application.Calculation = xlCalculationAutomatic
End Sub
 
Vote positif 0 Vote négatif
E

Excel_addin

XLDnaute Nouveau
Bonjour Didier, bonjour le forum
je te propose une solution.
Cordialement.

VB: 
Sub efface_test()

Application.ScreenUpdating = False
Calc = Application.Calculation
Application.Calculation = xlCalculationManual

    entete = "D, J, M, P, S, V, Y, AB, AE, AH, AK," & _
    "AN, AQ, AT, AW, AZ, AC, BC, BI, BL, BO," & _
    "BR, BU, BX, CA, CD, CG, CM, CP, CS, CV, CY," & _
    "ME, MH, MK, MN, MQ, MT, MW"

    For Each c In Split(entete, ",")
        Range(c & "4").Resize(30).ClearContents
    Next c

Application.ScreenUpdating = True
Application.Calculation = Calc

End Sub
 
Dernière édition:
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
d'accord, donc cela donne:

VB: 
Private Sub CommandButton7_Click()
Dim Address_en_Cours$
Application.Calculation = xlCalculationManual
For Each Address_en_Cours In Array("D4", "J4", "M4", "P4", "S4", "V4", "Y4", _
                                "AB4", "AC4", "AE4", "AH4", "AK4", "AN4", "AQ4", "AT4", "AW4", "AZ4", _
                                "BC4", "BI4", "BL4", "BO4", "BR4", "BU4", "BX4", _
                                "CA4", "CD4", "CG4", "CM4", "CP4", "CS4", "CV4", "CY4", _
                                "ME4", "MH4", "MK4", "MN4", "MQ4", "MT4", "MW4")
    Range(Address_en_Cours).Range("A1:A31").ClearContents
Next Address_en_Cours
Application.Calculation = xlCalculationAutomatic
End Sub
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Bonjour Didier, Excel_addin, le forum

je me suis demandé pourquoi tu cherchais à faire fonctionner la solution avec resize, alors j'ai regardé mon code et j'ai vu que j'avais laissé un bug sur la définition de variable.
voila le code testé et fonctionnel, j'en ai profité pour enlever la répétition des 4 comme Excel_Addin.
Désolé de cette écriture à la volée, j'aurais du tester mon code avant de le poster.
D'où l'intérêt de fournir un fichier exemple, cela évite aux contributeurs d'avoir à créer les données pour tester.

Bien cordialement
VB: 
Private Sub CommandButton7_Click()
Dim Address_en_Cours
Application.Calculation = xlCalculationManual
For Each Address_en_Cours In Array("D", "J", "M", "P", "S", "V", "Y", _
                                "AB", "AC", "AE", "AH", "AK", "AN", "AQ", "AT", "AW", "AZ", _
                                "BC", "BI", "BL", "BO", "BR", "BU", "BX", _
                                "CA", "CD", "CG", "CM", "CP", "CS", "CV", "CY", _
                                "ME", "MH", "MK", "MN", "MQ", "MT", "MW")
    Range(Address_en_Cours & 4).Range("A1:A31").ClearContents
Next Address_en_Cours
Application.Calculation = xlCalculationAutomatic
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif

Phil69970

XLDnaute Barbatruc
Bonjour @didier Costille , Yeahou , Excel_addin, le forum

Je te propose ceci :
VB: 
Sub SupCellule()
Dim NbCol&, i&
'On récupère le numéro de la dernière colonne remplie et on l'affecte à la variable NbCol
NbCol = Cells(1, Rows(1).Cells.Count).End(xlToLeft).Column

'Boucle de la colonne 10 (J) jusque la dernière colonne remplie
'Le Step 3 passe de 3 en 3 ==> la col 10 (colonne J) on passe à la col 13 (colonne M)etc...
For i = 4 To NbCol Step 3
    'si 7 (colonne G) alors on passe son tour sans rien faire
    If i <> 7 Then Range(Cells(4, i), Cells(34, i)).ClearContents
Next i
End Sub
*Remarques :
Je ne vois pas dans ta liste la colonne CJ ==> CJ4:CJ34 est ce volontaire ?
A la colonne CY cela s’arrête pour reprendre à la colonne ME est ce volontaire aussi ?
Si la réponse est oui au 2 remarques alors prends le code ci dessous
VB: 
Sub SupCellule1()
Dim i&
'Boucle de la colonne 10 (J) jusqu'à la colonne CJ
'Le Step 3 passe de 3 en 3 ==> la col 10 (colonne J) on passe à la col 13 (colonne M)etc...
For i = 4 To 103 Step 3
    'si 7 (colonne G)ou 88 (colonne CJ) alors on passe son tour sans rien faire
    If i <> 7 And i <> 88 Then Range(Cells(4, i), Cells(34, i)).ClearContents
Next i

'Suite de la  boucle pour ME à MW
For i = 343 To 361 Step 3
   Range(Cells(4, i), Cells(34, i)).ClearContents
Next i
End Sub
Dis moi si cela te convient.

@Phil69970
 
Dernière édition:
Vote positif 0 Vote négatif
D

Did25

XLDnaute Occasionnel
Bonsoir Phil69970 ,Yeahou, excel addin, excusez de mon retard ,je taffe de nuit en ce moment ,comme l'a fait remarqué Phil69970 ,je n'ai pas donner la totalité des cellules concernées ,une erreur de copier coller mais j'ai testé la formule de Yeahou :
Private Sub CommandButton7_Click()
Dim Address_en_Cours
Application.Calculation = xlCalculationManual
For Each Address_en_Cours In Array("D", "J", "M", "P", "S", "V", "Y", "AB", "AE", "AH", "AK", _
"AN", "AQ", "AT", "AW", "AZ", "BC", "BF", "BI", "BL", "BO", _
"BR", "BU", "BX", "CA", "CD", "CG", "CM", "CP", "CS", "CV", "CY", _
"DB", "DE", "DH", "DK", "DN", "DQ", "DT", "DW", "DZ", "EC", "EF", _
"EI", "EL", "EO", "ER", "EU", "EX", "FA", "FD", "FG", "FJ", "FM", _
"FP", "FS", "FV", "FY", "GB", "GE", "GH", "GK", "GN", "GQ", "GT", _
"GW", "GZ", "HC", "HF", "HI", "HL", "HC", "HU", "HX", "IA", "ID", _
"IG", "IJ", "IM", "IP", "IS", "IV", "IY", "JB", "JH", "JK", "JN", _
"JQ", "JT", "JW", "JZ", "KC", "KF", "KI", "KL", "KO", "KR", "KU", _
"KX", "LA", "LD", "LG", "LJ", "LM", "LP4", "LS4", "LV4", "LY4", "MB4", _
"ME", "MH", "MK", "MN", "MQ", "MT", "MW")
Range(Address_en_Cours & 4).Range("A1:A31").ClearContents
Next Address_en_Cours
Application.Calculation = xlCalculationAutomatic
End Sub

Nickel ça fonctionne plutôt bien ,j'ai testé la première formule de Phil69970 qui fonctionne aussi mais plus lente a l'éxécution ,merci vous tous ,merci XLD
 
Vote positif 0 Vote négatif

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Supporter XLD
Bonjour Didier

non, cela ne fonctionnera pas correctement. Tu as laissé des 4 dans le tableau, cela effacera à partir de la ligne 44 jusqu'à la ligne 74 sur les cellules concernées, "LP4", "LS4", "LV4", "LY4", "MB4"
sinon pour gagner un pouillième de temps de traitement tout en gardant le coté pratique.

Bien cordialement
VB: 
Private Sub CommandButton7_Click()
    Dim Address_en_Cours
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    On Error GoTo Gere_Erreurs
    For Each Address_en_Cours In Array("D", "J", "M", "P", "S", "V", "Y", "AB", "AE", "AH", "AK", _
                                    "AN", "AQ", "AT", "AW", "AZ", "BC", "BF", "BI", "BL", "BO", _
                                    "BR", "BU", "BX", "CA", "CD", "CG", "CM", "CP", "CS", "CV", "CY", _
                                    "DB", "DE", "DH", "DK", "DN", "DQ", "DT", "DW", "DZ", "EC", "EF", _
                                    "EI", "EL", "EO", "ER", "EU", "EX", "FA", "FD", "FG", "FJ", "FM", _
                                    "FP", "FS", "FV", "FY", "GB", "GE", "GH", "GK", "GN", "GQ", "GT", _
                                    "GW", "GZ", "HC", "HF", "HI", "HL", "HC", "HU", "HX", "IA", "ID", _
                                    "IG", "IJ", "IM", "IP", "IS", "IV", "IY", "JB", "JH", "JK", "JN", _
                                    "JQ", "JT", "JW", "JZ", "KC", "KF", "KI", "KL", "KO", "KR", "KU", _
                                    "KX", "LA", "LD", "LG", "LJ", "LM", "LP", "LS", "LV", "LY", "MB", _
                                    "ME", "MH", "MK", "MN", "MQ", "MT", "MW")
        Range(Address_en_Cours & 4).Range("A1:A31").ClearContents
    Next Address_en_Cours
Gere_Erreurs:
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
 
Vote positif 0 Vote négatif
Solution
Identifiez-vous ou inscrivez-vous pour participer.
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…