XL 2016 Multiplication de plusieurs cellules au clic sur un bouton

[Fahim3u]

Multiplication de plusieurs cellules au clic sur un bouton

Salut les gars j'ai un petit problème sur excel . Je voudrais appliquer une formule a des cellules dans mon classeur. Le principe c'est de multiplier toutes les valeurs des cellules *24 une fois que je clique sur un bouton. Pouvez vous maider Merci d'avance Merci .

 

[CHALET53]

Pourquoi un bouton ?

 

[Fahim3u]

Salut chalet en faite moi je voudrais que la modification des valeurs lors de la multiplication ca se fait dans le meme tableau . Et normalement les valeurs sont en format heure jai deja fait un macro pour convertir les valeur en nombre et ce que je veux mtn c de multiplier les valeurs en nombre * 24 sur le mm tableau en appuyant sur le bouton . Lobjectif c de faire les modification sur le mm tableau et ne pas faire un autre.

 

[Fahim3u]

Comme ca

 

[job75]

Bonjour Fahim3u, CHALET53,

Voyez le fichier joint et ces macros :

Sub X_24()
Application.ScreenUpdating = False
[A1] = 24
[A1].Copy
[A7:C9].PasteSpecial xlPasteValues, Operation:=xlMultiply 'plage à adapter
[A1] = ""
[A1].Select
Application.CutCopyMode = 0
End Sub

Sub DIV_24()
Application.ScreenUpdating = False
[A1] = 24
[A1].Copy
[A7:C9].PasteSpecial xlPasteValues, Operation:=xlDivide 'plage à adapter
[A1] = ""
[A1].Select
Application.CutCopyMode = 0
End Sub

A+

 

[job75]

Une solution par tableaux VBA dans ce fichier(2) :

Sub X_24()
Dim P As Range, tablo, ncol%, i&, j%, x$
Set P = [A7:C9] 'à adapter
tablo = P.Resize(P.Rows.Count + 1) 'matrice, plus rapide, au moins 2 éléments
ncol = UBound(tablo, 2)
For i = 1 To UBound(tablo) - 1
    For j = 1 To ncol
        x = CStr(tablo(i, j))
        If IsNumeric(x) Then tablo(i, j) = x * 24
Next j, i
P = tablo
End Sub

Sub DIV_24()
Dim P As Range, tablo, ncol%, i&, j%, x$
Set P = [A7:C9] 'à adapter
tablo = P.Resize(P.Rows.Count + 1) 'matrice, plus rapide, au moins 2 éléments
ncol = UBound(tablo, 2)
For i = 1 To UBound(tablo) - 1
    For j = 1 To ncol
        x = CStr(tablo(i, j))
        If IsNumeric(x) Then tablo(i, j) = x / 24
Next j, i
P = tablo
End Sub

Pour tester j'ai recopié le tableau A7:C9 sur 120 000 lignes :

- fichier (1) => 0,24 seconde

- fichier (2) => 1,4 seconde, 6 fois moins rapide.

A+

 

[Staple1600]

Bonjour le fil, Fahim3u, Chalet53, job75

Une version paramétrée (pour avoir les 4 opérations à dispostion et utiliser les possibilités offertes par Intellisense dans VBE)

 Sub test1()
PasteSpOP xlPasteSpecialOperationDivide
End Sub
Sub test2()
PasteSpOP xlPasteSpecialOperationMultiply, 2
End Sub

Sub test2b()
PasteSpOP 4, 2
End Sub
Private Sub PasteSpOP(op As XlPasteSpecialOperation, Optional oper As Double = 24)
Cells(Rows.Count, Columns.Count) = oper
Cells(Rows.Count, Columns.Count).Copy
Set r = Selection
r.PasteSpecial xlPasteValues, Operation:=op
End Sub

Pour tester, mettre quelques nombres dans un colonne puis sélectionner les données dans cette colonne et lancer les macros selon le besoin.
(Voir les exemples test)
PS: proposition émise pour le fun et pour varier les plaisirs dans VBE.

 

[job75]

Bonjour JM,

Plutôt que des boutons on peut utiliser une liste de validation, fichier (3) :

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [Choix]) Is Nothing And [Choix] <> "" Then Macro
End Sub

Sub Macro()
Application.ScreenUpdating = False
[A1] = 24
[A1].Copy
[A7:C9].PasteSpecial xlPasteValues, Operation:=IIf([Choix] = "X 24", xlMultiply, xlDivide) 'plage à adapter
[A1] = ""
[Choix].Select
Application.CutCopyMode = 0
End Sub

A+

 

[Fahim3u]

Bonjour les gars . Merci bcp ca marche tres bien . Jai juste un petit problème par rapport aux cellules vides j'aimerais bien ne pas avoir la valeur zero 0 lorsque j'appuie sur le bouton

 

[job75]

Bonsoir à tous,

j'aimerais bien ne pas avoir la valeur zero 0 lorsque j'appuie sur le bouton

Il suffit de remplir provisoirement les cellules vides avec le texte "µ" :

Sub X_24()
Application.ScreenUpdating = False
[A1] = 24
With [A7:C9] 'plage à adapter
    .Replace "", "µ", xlWhole 'remplace les vides par µ
    [A1].Copy
    .PasteSpecial xlPasteValues, Operation:=xlMultiply
    .Replace "µ", "" 'efface les µ
End With
[A1] = ""
[A1].Select
Application.CutCopyMode = 0
End Sub

Sub DIV_24()
Application.ScreenUpdating = False
[A1] = 24
With [A7:C9] 'plage à adapter
    .Replace "", "µ", xlWhole 'remplace les vides par µ
    [A1].Copy
    .PasteSpecial xlPasteValues, Operation:=xlDivide
    .Replace "µ", "" 'efface les µ
End With
[A1] = ""
[A1].Select
Application.CutCopyMode = 0
End Sub

Voyez ces fichiers (1 bis) et (3 bis) avec la cellule vide B8.

A+

 

[Fahim3u]

Merci bcp. job 75 tes un génie

 

[job75]

Noter que maintenant sur 120 000 lignes les macros s'exécutent en 2,1 secondes (à cause des Replace).

Alors que la macro du post #6 (tableaux VBA) s'exécute en 1,3 seconde.