If date=mois en cours then...

Résolu/Fermé

Aki - 27 juil. 2016 à 17:05
NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020 - 29 juil. 2016 à 09:21

Bonjour,

J'ai une super formule Excel que je n'arrive pas à traduire en VBA :
=SI(ET(O37>=FIN.MOIS(AUJOURDHUI();-1)+1;O37<=FIN.MOIS(AUJOURDHUI();0));1;0)

Merci d'avance pour vos réponses.

A voir également:

Vba mois en cours
Panne tnt en cours aujourd'hui - Guide
Association avec le serveur freebox en cours ✓ - Forum Freebox
En cours de livraison ✓ - Forum Consommation & Internet
Vba l'indice n'appartient pas à la sélection - Forum VB / VBA
Arret en cours infini ✓ - Forum Windows 8 / 8.1

5 réponses

Réponse 1 / 5

Utilisateur anonyme
27 juil. 2016 à 17:19

Bonjour Aki,

Si tu veux mettre ta formule en B2, essaye :

[B2].Formula = "=IF(AND([O37]>=EOMONTH(TODAY(),-1)+1,[O37]<=EOMONTH(TODAY(),0)),1,0)"

Si ton problème est réglé, merci d'aller en haut de page pour
cliquer sur « Marquer comme résolu ».

Cordialement. 😊

Aki
27 juil. 2016 à 17:25

Merci Albkan
Cependant (et si j'ai bien compris ton code) le contenu de ma cellule n'est pas une formule mais une date de type texte "31/07/2016"

Le code une fois adapté a ton code a donné ça et qui ne fonctionne pas :
If Range("O" & i).Formula = "=IF(AND([O37]>=EOMONTH(TODAY(),-1)+1,[O37]<=EOMONTH(TODAY(),0)),1,0)" Then
Range("O" & i).Interior.Color = RGB(255, 0, 0)
End If

Encore merci.

Utilisateur anonyme > Aki
27 juil. 2016 à 18:12

Regarde le message #3 de Gyrus ; sa réponse est plus juste que la mienne. :)

NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020 1
27 juil. 2016 à 18:12

Merci

Réponse 2 / 5

Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523
27 juil. 2016 à 18:02

Bonjour,

=FIN.MOIS(AUJOURDHUI();-1)+1 permet de définir le premier jour du mois en cours.
=FIN.MOIS(AUJOURDHUI();0) permet de définir le dernier jour du mois en cours.
La formule globale permet donc de définir si O37 indique une date du mois en cours.

Avec VBA, tu peux te contenter de comparer l'année et le mois :

    If Year(Range("O" & i).Value) = Year(Date) And Month(Range("O" & i).Value) = Month(Date) Then
        Range("O" & i).Interior.Color = RGB(255, 0, 0)
    Else
        Range("O" & i).Interior.Color = xlNone
    End If

A+

NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020 1
27 juil. 2016 à 18:14

ça ne fonctionne pas :(

voici le code complet, si tu veux bien m'aider :

Private Sub Controle_Click()
Dim nb_lignes As Integer ', DernCol As Integer ', Ctr As Integer
nb_lignes = WorksheetFunction.CountA(Range("A:A"))

Sheets("VERIFAPRESPAIE").Activate

Cells.Select
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0

For i = 1 To nb_lignes
'For Ctr = 1 To DernCol

'supprimer les couleurs déjà existantes

'Range(Ctr & i).Interior.ColorIndex = xlNone

'colorer les cellules vides => Colonne J
If Range("J" & i) = 0 Then
Range("J" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If
'colorer les cellules comprenant une date = mois en cours => Colonne O
If Year(Range("O" & i).Value) = Year(Date) And Month(Range("O" & i).Value) = Month(Date) Then
Range("O" & i).Interior.Color = RGB(255, 0, 0)
End If
'colorer les contenant le texte "Chèque " => Colonne U
If Range("U" & i) = "Chèque " Then
Range("U" & i).Interior.Color = RGB(255, 0, 0)
End If
'colorer les cellules < 0 => Colonne BI
If Range("BI" & i) < 0 Then
Range("BI" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If
'colorer les cellules <> 0 => Colonne BO
If Range("BO" & i) <> 0 Then
Range("BO" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If
'colorer les cellules <> 0 => Colonne BP
If Range("BP" & i) <> 0 Then
Range("BP" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If
'colorer les cellules <> 0 => Colonne BQ
If Range("BQ" & i) <> 0 Then
Range("BQ" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If

'colorer les cellules <> 0 => Colonne BR
If Range("BR" & i) <> 0 Then
Range("BR" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If
'colorer les cellules CH=0 ET CJ<>0 => Colonne CJ
If Range("CH" & i) = 0 And Range("CJ" & i) <> 0 Then
Range("CJ" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If

'colorer les cellules CI=0 ET CK<>0 => Colonne CK
If Range("CI" & i) = 0 And Range("CK" & i) <> 0 Then
Range("CK" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If

'colorer les cellules CL=0 ET CM<>0 => Colonne CL ET CM
If Range("CL" & i) = 0 And Range("CM" & i) <> 0 Then
Range("CM" & i).Interior.Color = RGB(255, 0, 0) ': rouge
End If

'Next
Next
Call ColorControle
End With
End Sub
Sub ColorControle()
'Ajouter un "X" si ligne à contrôler
Const lideb = 2
Const codeb = 1
Dim cofin As Long, co As Long, li As Long, lifin As Long
Application.ScreenUpdating = False
With ActiveSheet
lifin = .Cells(Rows.Count, 1).End(xlUp).Row
cofin = .Cells(1, Columns.Count).End(xlToLeft).Column
.Cells(1, cofin + 1).Value = "Contrôle"
For li = lideb To lifin
For co = codeb To cofin
If .Cells(li, co).Interior.ColorIndex <> xlNone Then
.Cells(li, cofin + 1).Value = "X"
Exit For
End If
Next co
Next li
End With
Application.ScreenUpdating = True
End Sub

NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020 1
27 juil. 2016 à 18:15

Erreur d'execution type '13' : Incompatibilité de type
=> If Year(Range("O" & i).Value) = Year(Date) And Month(Range("O" & i).Value) = Month(Date) Then

Gyrus Messages postés 3334 Date d'inscription samedi 20 juillet 2013 Statut Membre Dernière intervention 9 décembre 2016 523 > NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020
27 juil. 2016 à 20:01

Lorsque le programme s'interrompt, tu peux regarder la valeur de

Range("O" & i).Value

Sinon, joins un fichier exemple.
A+

Utilisateur anonyme > NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020
27 juil. 2016 à 22:27

Bonsoir NaXiLeAn,

J'ai revu entièrement ton code, et voici ce que ça donne :


Option Explicit

Dim cellX As Range


Private Sub EnRouge()
  cellX.Interior.Color = RGB(255, 0, 0)
End Sub


Private Sub Controle_Click()

  Dim dcol As Integer, dlig As Long, i As Long

  Worksheets("VERIFAPRESPAIE").Select
  
  ' dernière colonne et dernière ligne
  dcol = Cells(1, Columns.Count).End(xlToLeft).Column
  dlig = Range("A" & Rows.Count).End(xlUp).Row

  'supprimer les couleurs déjà existantes
  Range([A1], Cells(dlig, dcol)).Interior.ColorIndex = xlNone

  For i = 1 To dlig

    Set cellX = Range("J" & i): If cellX = 0 Then EnRouge                 ' col J : si vide
    
    Set cellX = Range("O" & i)                                           ' test colonne O :
    If IsEmpty(cellX) Then
      EnRouge                                             ' si O est vide => date manquante
    Else
      If IsDate(cellX) Then                                     ' si date O = mois en cours
        If Year(cellX) = Year(Date) And Month(cellX) = Month(Date) Then EnRouge
      Else
        EnRouge                                             ' si O ne contient pas une date
      End If
    End If

    Set cellX = Range("U" & i): If cellX = "Chèque" Then EnRouge      ' col U : si "Chèque"
    
    Set cellX = Range("BI" & i): If cellX < 0 Then EnRouge               ' col BI : si < 0
    Set cellX = Range("BO" & i): If cellX <> 0 Then EnRouge              ' col BO : si <> 0
    Set cellX = Range("BP" & i): If cellX <> 0 Then EnRouge              ' col BP : si <> 0
    Set cellX = Range("BQ" & i): If cellX <> 0 Then EnRouge              ' col BQ : si <> 0
    Set cellX = Range("BR" & i): If cellX <> 0 Then EnRouge              ' col BR : si <> 0
    
    Set cellX = Range("CJ" & i)                             ' col CJ : si CH = 0 et CJ <> 0
    If cellX.Offset(, -2) = 0 And cellX <> 0 Then EnRouge
    
    Set cellX = Range("CK" & i)                             ' col CK : si CI = 0 et CK <> 0
    If cellX.Offset(, -2) = 0 And cellX <> 0 Then EnRouge
    
    Set cellX = Range("CM" & i)                             ' col CM : si CL = 0 et CM <> 0
    If cellX.Offset(, -2) = 0 And cellX <> 0 Then EnRouge
    
  Next i

  Call ColorContrôle

End Sub


Sub ColorContrôle() 'Ajouter un "X" si ligne à contrôler
  Dim dcol As Integer, dlig As Long, lig As Long, col As Integer
  Application.ScreenUpdating = False
  dcol = Cells(1, Columns.Count).End(xlToLeft).Column
  dlig = Range("A" & Rows.Count).End(xlUp).Row
  Cells(1, dcol + 1) = "Contrôle"
  For lig = 2 To dlig
    For col = 1 To dcol
      If Cells(lig, col).Interior.ColorIndex <> xlNone Then
        Cells(lig, dcol + 1) = "X": Exit For
      End If
    Next col
  Next lig
End Sub

Dis-moi ce que tu en penses, et n'hésites pas à me demander
des informations supplémentaires si besoin.

Cordialement. 😊

NaXiLean
27 juil. 2016 à 22:34

Bonsoir
Çà m'a l'air beaucoup pkus clean!!!
Je test ca demain matin et je te tiens qu courant.
merci beaucoup

Réponse 3 / 5

ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
Modifié par ccm81 le 27/07/2016 à 22:04

Bonsoir

1. La proposition de Gyrus que je salue au passage fonctionne correctement
1.1. Il te faut commencer la boucle sur i à la ligne 2

For i = 2 to nb_lignes
...

1.2. Il te faut tester si Range("O" & i).Value est bien une date

    If IsDate(Range("O" & i).Value) Then
      If Year(Range("O" & i).Value) = Year(Date) And Month(Range("O" & i).Value) = Month(Date) Then
        Range("O" & i).Interior.Color = RGB(255, 0, 0)
      End If
    End If

2. je me suis permis quelques allègements
http://www.cjoint.com/c/FGBuaXPIDOe

Cdlmnt

NaXiLean
27 juil. 2016 à 22:36

Ccm811111111111!!!!!

NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020 1
28 juil. 2016 à 09:15

Bonjour ccm81,
Merci ça fonctionne!!!

Réponse 4 / 5

ccm81 Messages postés 10851 Date d'inscription lundi 18 octobre 2010 Statut Membre Dernière intervention 16 avril 2024 2 404
28 juil. 2016 à 11:04

Re

Celui là va un peu plus vite
http://www.cjoint.com/c/FGCjcUtWoxe

Cdlmnt

NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020 1
28 juil. 2016 à 11:34

Merci ccm81 :D

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 5

NaXiLeAn Messages postés 112 Date d'inscription mercredi 27 juillet 2016 Statut Membre Dernière intervention 2 juin 2020 1
29 juil. 2016 à 09:21

Bonjour et merci à tous pour votre aide.
Juste au cas où, j'ai une autre question pour le même code (toujours et encore), que j'ai appelé :

VBA-Copie données ficher 1 feuille A vers ficher 2 feuille V

Merci :D

Discussions similaires

Colis en cours de transport vers votre site de livraison ?

Envoi en cours de livraison

Formule Excel pour afficher les mois (chiffres) en lettre

Ressource demandée en cours d'utilisation

il est en cours de transport vers votre site de livraison

Discussions similaires

Newsletters