If date=mois en cours then...

Résolu
Aki -  
NaXiLeAn Messages postés 122 Statut Membre -
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.

5 réponses

  1. 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.  😊
     
    1
    1. 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.
      0
      1. Utilisateur anonyme > Aki
         
        Regarde le message #3 de Gyrus ; sa réponse est plus juste que la mienne. :)
        0
    2. NaXiLeAn Messages postés 122 Statut Membre 1
       
      Merci
      0
  2. Gyrus Messages postés 3360 Statut Membre 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+
    1
    1. NaXiLeAn Messages postés 122 Statut Membre 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
      0
    2. NaXiLeAn Messages postés 122 Statut Membre 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
      0
    3. Gyrus Messages postés 3360 Statut Membre 526 > NaXiLeAn Messages postés 122 Statut Membre
       
      Lorsque le programme s'interrompt, tu peux regarder la valeur de 
      Range("O" & i).Value

      Sinon, joins un fichier exemple.
      A+
      0
    4. Utilisateur anonyme > NaXiLeAn Messages postés 122 Statut Membre
       
      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.  😊
       
      0
    5. NaXiLean
       
      Bonsoir
      Çà m'a l'air beaucoup pkus clean!!!
      Je test ca demain matin et je te tiens qu courant.
      merci beaucoup
      0
  3. ccm81 Messages postés 11033 Statut Membre 2 434
     
    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
    1
    1. NaXiLean
       
      Ccm811111111111!!!!!
      0
    2. NaXiLeAn Messages postés 122 Statut Membre 1
       
      Bonjour ccm81,
      Merci ça fonctionne!!!
      0
  4. ccm81 Messages postés 11033 Statut Membre 2 434
     
    Re

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

    Cdlmnt
    1
    1. NaXiLeAn Messages postés 122 Statut Membre 1
       
      Merci ccm81 :D
      0

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

    Posez votre question
  6. NaXiLeAn Messages postés 122 Statut Membre 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
    0

Discussions similaires

Colis en cours de transport vers votre site de livraison ?
Ninan_5568 -
JulieVdr -

7 réponses
convertir heures de travail en mois
malolita -
Isa -

23 réponses