Multiple de
Bonsoir le forum
J'ai du ouvrir un autre post parce que j'avais mis résolu
Bonsoir Xorsankukai
le précédent fichier fonctionnait bien, mais il 'arrête à mi parcours (le petit paresseux)
dans la colonne A il bute sur 4200
s'il était possible de me le corriger ce serait sympathique de ta part
Dim c As Range, dl As Integer
Application.ScreenUpdating = False
dl = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de la colonne A
For Each c In Range("A7:A" & dl) 'de A7 à la dernière ligne
c.Interior.ColorIndex = xlNone 'on efface les couleurs
c.Offset(0, 5).ClearContents 'efface les données en F
If Range("C1") <> "" And Range("C1") <> 0 Then 'si C1 nest pas vide et différent de 0
If c.Value Mod Range("C1") = 0 Then 'si multiple de C1
c.Interior.ColorIndex = 7 'couleur violet
c.Offset(0, 5) = "ok" 'ok en F
End If
Else
c.Interior.ColorIndex = xlNone 'sinon pas de couleur
End If
Next c
Application.ScreenUpdating = True
End Sub
Merci par avance
Bonsoir letranquille,
il 'arrête à mi parcours (le petit paresseux)
dans la colonne A il bute sur 4200
Je viens de tester le fichier avec 12 000 lignes, toutes les lignes sont traitées?
Penses à utiliser la balise </> pour rendre le code plus lisible.
Sub Bouton1_Cliquer()
Dim c As Range, dl As Integer
Application.ScreenUpdating = False
dl = Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de la colonne A
For Each c In Range("A7:A" & dl) 'de A7 à la dernière ligne
c.Interior.ColorIndex = xlNone 'on efface les couleurs
c.Offset(0, 5).ClearContents 'efface les données en F
If Range("C1") <> "" And Range("C1") <> 0 Then 'si C1 nest pas vide et différent de 0
If c.Value Mod Range("C1") = 0 Then 'si multiple de C1
c.Interior.ColorIndex = 7 'couleur violet
c.Offset(0, 5) = "ok" 'ok en F
End If
Else
c.Interior.ColorIndex = xlNone 'sinon pas de couleur
End If
Next c
Application.ScreenUpdating = True
End Sub
Cordialement,
Bonsoir le forum
Bonsoir Xorsankukai
Merci Beaucoup
et bonne soirée à tous
Salut LeTranquille,
Salut Xorsankukai,
je crois que tout le forum sait que je préfère VBA, et de loin, mais, quand c'est possible, pourquoi pas une MFC ?
Après avoir sélectionné la colonne [A], voici la formule MFC :
=ET($A1<>"";MOD($A1;$C$1)=0)
Tant qu'à faire, si ça peut te rendre service, une formule pour [F7] à tirer vers le bas.
=SI(MOD($A7;$C$1)=0;"OK";"")
Et, enfin, je gage que ton code VBA ne devait pas fonctionner terrible, terrible, non ?
Private Sub Worksheet_Change(ByVal Target As Range)
'
Dim iOK%
'
Application.EnableEvents = False
'
If Not Intersect(Target, Range("C1")) Is Nothing Then
iOK = 0
If Not IsNumeric([C1]) Or [C1] = 0 Or [C1] = "" Then iOK = 1
If iOK = 0 Then If [C1] - CInt([C1]) <> 0 Then iOK = 1
If iOK = 1 Then
MsgBox "Veuillez saisir un nombre entier!", vbInformation + vbOKOnly, "Multiples"
[C1].ClearContents
End If
[C1].Select
End If
'
Application.EnableEvents = True
'
End Sub
Avec plaisir!
A+
Bonjour curulis57,
J'avais également proposé une solution via MFC qui n'a pas été retenue, le demandeur voulant explicitement du vba.
https://forum.excel-pratique.com/viewtopic.php?p=807432#p807432
je gage que ton code VBA ne devait pas fonctionner terrible, terrible, non ?
Je suis autodidacte et m'efforce de progresser à l'aide du forum, mais je constate qu'il me reste énormément à apprendre,
Donc un grand merci pour ton intervention qui va m'aider à progresser,
Juste une petite question:
If [C1] - CInt([C1]) <> 0
ce code sert à vérifier si le critère est un nombre décimal ?
Peux-tu proposer une version VBA (sans MFC) où optimiser mon code afin que je comprenne mes erreurs ?
Merci,
Amitiés,
Bonjour le forum
Excuse xorsankukai, je n'avais vu le dernier post
Merci pour toute l'attention porter à mes posts
sans oublier les autres intervenants
Salut tout le monde,
@Xorsankukai,
déso, j'avais perdu ta demande de vue...
Voici donc ton code, légèrement amélioré : +- 50% de gain en rapidité.
Sub Bouton1_Cliquer()
'
Dim c As Range, dl As Integer
'
Application.EnableEvents = False
Application.ScreenUpdating = False
'
With Sheets("Feuil1")
If .[C1] > 0 Then
dl = .Range("A" & Rows.Count).End(xlUp).Row 'dernière ligne de la colonne A
.Range("A7:A" & dl).Interior.Color = xlNone
.Range("F7:F" & dl).Value = ""
'
For Each c In .Range("A7:A" & dl) 'de A7 à la dernière ligne
If c.Value Mod .[C1] = 0 Then 'si multiple de C1
c.Interior.ColorIndex = 7 'couleur violet
c.Offset(0, 5) = "ok" 'ok en F
End If
Next
End If
End With
'
Application.ScreenUpdating = True
Application.EnableEvents = True
'
End Sub
If [C1] - CInt([C1]) <> 0
sert effectivement à détecter un nombre avec décimales.
Avec plaisir,
A+
Bonjour Curulis57,
@Xorsankukai,
déso, j'avais perdu ta demande de vue...
Voici donc ton code, légèrement amélioré : +- 50% de gain en rapidité.
Un grand merci pour ton code !
Il est vrai que le traitement est beaucoup plus fluide,
Bonne soirée, et à bientôt sur le forum,
Amitiés.
Bonsoir le forum
Bonsoir Curulus57, Xorsankukai
Merci d'avoir résolu mon petit souci
Merci à vous pour votre aide et passer une bonne soirée