XL 2019 scinder une formule vba

Did25 · 28 Février 2021

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("D4

34,J4:J34,M4:M34,P4

34,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

Bernard_XLD · 28 Février 2021

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

Did25 · 28 Février 2021

Bonsoir Yeahou, Range("AC4:BC34")est une erreur je pense que c'était plutôt (AC4:AC34,BC4:BC34).

Excel_addin · 28 Février 2021

didier Costille à dit:
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

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

Bernard_XLD · 28 Février 2021

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

Did25 · 1 Mars 2021

Bonsoir Excel_addin , j'ai testé votre formule et je rencontre une erreur sur:

Range(c & "4").Resize(30).ClearContents
Je sèche complètement .

Bernard_XLD · 1 Mars 2021

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

Phil69970 · 1 Mars 2021

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

Did25 · 1 Mars 2021

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

Bernard_XLD · 1 Mars 2021

didier Costille à dit:
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

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

Did25 · 1 Mars 2021

Merci Yeahou ,pour l'erreur j'avais pas vu ,j'ai testé ta formule c'est nickel top ,bravo les experts ,merci a tous bonne soirée

Effectuez une recherche sur Excel Downloads...

XL 2019 scinder une formule vba

Did25

XLDnaute Occasionnel

Bernard_XLD

Bernard_XLD

XLDnaute Barbatruc

Did25

XLDnaute Occasionnel

Excel_addin

XLDnaute Nouveau

Bernard_XLD

XLDnaute Barbatruc

Did25

XLDnaute Occasionnel

Bernard_XLD

XLDnaute Barbatruc

Phil69970

XLDnaute Barbatruc

Did25

XLDnaute Occasionnel

Bernard_XLD

XLDnaute Barbatruc

Did25

XLDnaute Occasionnel

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums