If date=mois en cours then...
Résolu
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.
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
-
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 -
Re
Celui là va un peu plus vite
http://www.cjoint.com/c/FGCjcUtWoxe
Cdlmnt -
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 2For 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 -
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+-
ç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 -
-
@NaXiLeAnLorsque le programme s'interrompt, tu peux regarder la valeur de
Range("O" & i).Value
Sinon, joins un fichier exemple.
A+ -
@NaXiLeAnBonsoir 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. 😊
-
-
-
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. 😊
-
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. -
@AkiRegarde le message #3 de Gyrus ; sa réponse est plus juste que la mienne. :)
-
-
