If date=mois en cours then...

Résolu

Aki -
NaXiLeAn Messages postés 112 Date d'inscription Statut Membre Dernière intervention - 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.

Afficher la suite

A voir également:

Excel mois en cours
Liste déroulante excel - Guide
Mise en forme conditionnelle excel - Guide
Word et excel gratuit - Guide
Déplacer colonne excel - Guide
Panne tnt en cours aujourd'hui - Guide

5 réponses

Réponse 1 / 5

Utilisateur anonyme

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

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

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

NaXiLeAn Messages postés 112 Date d'inscription Statut Membre Dernière intervention 1

Merci

Réponse 2 / 5

Gyrus Messages postés 3334 Date d'inscription Statut Membre Dernière intervention 526

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 Statut Membre Dernière intervention 1

ç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 Statut Membre Dernière intervention 1

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 Statut Membre Dernière intervention 526 > NaXiLeAn Messages postés 112 Date d'inscription Statut Membre Dernière intervention

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 Statut Membre Dernière intervention

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

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 10909 Date d'inscription Statut Membre Dernière intervention 2 433

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

Ccm811111111111!!!!!

NaXiLeAn Messages postés 112 Date d'inscription Statut Membre Dernière intervention 1

Bonjour ccm81,
Merci ça fonctionne!!!

Réponse 4 / 5

ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention 2 433

Re

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

Cdlmnt

NaXiLeAn Messages postés 112 Date d'inscription Statut Membre Dernière intervention 1

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 Statut Membre Dernière intervention 1

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

Formule Excel pour afficher les mois (chiffres) en lettre

Convertir un mois en chiffre en lettre RESOLU

Colis en cours de transport vers votre site de livraison ?

Conversion cellule avec mois en chiffre en mois en lettre

Votre réponse

Discussions similaires