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