Transformation de dates en trimestre

Résolu
Dianex87 -  
Bonjour,

Je débute en VBA. Sur un fichier Excel 2010 j'essaie de créer une macro qui va, selon la valeur contenue dans la colonne AD, mettre en AE de quel trimestre et année il s'agit (format QX 201Y). Jusque là ça va, j'y parviens sur un fichier test simple.

Sauf que dans mon cas les utilisateurs du fichier remplissent la colonne AD avec divers formats de date en général, mais aussi des termes du genre N/A, Available ou même Q2 2017, soit le format souhaité en AE. Il y a aussi des cellules vides, pour laquelle l'info n'est pas encore dispo.
Dans ce "vrai" fichier donc, mon code ne fonctionne plus: "Run time error '13': Type mismatch" est le msg d'erreur. Code ci-dessous:

Sub autofill()

Dim LastrowK As Long, LastrowAE As Long, LastrowAD As Long, cellSolution As Range

With Sheets("External TFU-TDO")
LastrowK = .Cells(.Rows.Count, "K").End(xlUp).Row
LastrowAE = .Cells(.Rows.Count, "AE").End(xlUp).Row
LastrowAD = .Cells(.Rows.Count, "AD").End(xlUp).Row
End With

' Autofill of solution availability in QuarterX 201Y way
' In any date formats, the macro will ran QY 201X
' If the date is already in a Quarter format, no change
' If it is "N/A" no change
' If it is "Available", the macro will ran "Solution Available"

For Each cellSolution In Range(Cells(3, 29), Cells(LastrowK, 29))

If Month(cellSolution.Value) >= 1 And Month(cellSolution.Value) <= 3 Then
cellSolution.Offset(0, 1).Value = "Q1" & " " & Year(cellSolution.Value)
ElseIf Month(cellSolution.Value) >= 4 And Month(cellSolution.Value) <= 6 Then
cellSolution.Offset(0, 1).Value = "Q2" & " " & Year(cellSolution.Value)
ElseIf Month(cellSolution.Value) >= 7 And Month(cellSolution.Value) <= 9 Then
cellSolution.Offset(0, 1).Value = "Q3" & " " & Year(cellSolution.Value)
ElseIf Month(cellSolution.Value) >= 10 And Month(cellSolution.Value) <= 12 Then
cellSolution.Offset(0, 1).Value = "Q4" & " " & Year(cellSolution.Value)

End If

Next cellSolution

End Sub

Je pense que c'est parce qu'il y a dans la colonne AD des valeurs qui ne sont pas en formats date mais string, et du coup "If Month(cellSolution.Value) >= 1" bug...

Je ne sais pas comment contourner celà, d'autant plus qu'en plus de transformer les dates en trimestres je voudrais que ma macro conserve en AE le format Qx 201Y si déjà renseigné tel quell, du vide si Ad est vide, et "Available" si le cas en AD.

Merci de votre aide,
J'espère avoir été Claire.... Merci d em'avoir lue jusque là ! :)

Dianex87

3 réponses

  1.  yg_be Contributeur
    bonjour, suggestion: 
    Dim mois As Integer
Dim trimestre As integer

For Each cellSolution In Range(Cells(3, 29), Cells(LastrowK, 29))
    If IsDate(cellSolution.Value) Then
        mois = Month(cellSolution.Value)
        trimestre = 1 + (mois-1) \ 3
        cellSolution.Offset(0, 1).Value = "Q" & trimestre & " " & Year(cellSolution.Value)
    Else
        cellSolution.Offset(0, 1).Value = cellSolution.Value
    End If
Next cellSolution
    1. Dianex87 Auteur
      Merci pour votre réponse! (vos réponses, j'ai vu aussi la 1ère proposition :) )

      Alors j'essaye et ça me retourne un msg d'erreur: "Run time error 1004: Application-defined or object-defined error".
      La ligne "For each cellSolution ... est surlignée en jaune.
      Et en passant mon curseur dessus, je peux lire: "Range(Cells(3,30), Cells(Last...) =<Application defined or object-defined error>. Que signigfie cela ?
      Il y aussi "cellSolution.Offset(0, 1).Value ="<Object variable or with block variable not set">...

      Sub autofill()

      Dim mois As Integer
      Dim trimestre As Integer
      Dim cellSolution As Range

      For Each cellSolution In Range(Cells(3, 30), Cells(LastrowK, 30))
      If IsDate(cellSolution.Value) Then
      mois = Month(cellSolution.Value)
      trimestre = 1 + (mois - 1) \ 3
      cellSolution.Offset(0, 1).Value = "Q" & trimestre & " " & Year(cellSolution.Value)
      Else
      cellSolution.Offset(0, 1).Value = cellSolution.Value
      End If
      Next cellSolution

      End Sub

      Merci bcp!!
      Dianex87
    2. michel_m Contributeur
      @Dianex87Bonjour

      dans dernière macro , tu n'as déterminé LastrowK

      pour l calcul de trimestre fais une division "/" au lieu de "\"
      ton calcul ne marche pour tous les mois
      par ex=
      Mai=5
      1+(5-1)/3 ---> 2,3333 et mois est déclaré en integer (byte aurait suffi)---> erreur!

      essaies
      application.Int((mois+2)/3)
    3. yg_be Contributeur
      @Dianex87Peux-tu essayer ainsi: 
      Sub autofill() 

Dim LastrowK As Long, LastrowAE As Long, LastrowAD As Long, cellSolution As Range 
Dim mois As Integer
Dim trimestre As integer

With Sheets("External TFU-TDO") 
LastrowK = .Cells(.Rows.Count, "K").End(xlUp).Row 
LastrowAE = .Cells(.Rows.Count, "AE").End(xlUp).Row 
LastrowAD = .Cells(.Rows.Count, "AD").End(xlUp).Row 
End With 

' Autofill of solution availability in QuarterX 201Y way 
' In any date formats, the macro will ran QY 201X 
' If the date is already in a Quarter format, no change 
' If it is "N/A" no change 
' If it is "Available", the macro will ran "Solution Available" 

For Each cellSolution In Range(Cells(3, 29), Cells(LastrowK, 29))
    If IsDate(cellSolution.Value) Then
        mois = Month(cellSolution.Value)
        trimestre = 1 + (mois-1) \ 3
        cellSolution.Offset(0, 1).Value = "Q" & trimestre & " " & Year(cellSolution.Value)
    Else
        cellSolution.Offset(0, 1).Value = cellSolution.Value
    End If
Next cellSolution

End Sub
    4. Dianex87 Auteur
      @yg_beMille mercis, ça marche top !!!

      Un dernier extra dans ma macro please:

      Et si je voudrais que, dans le cas où la valeur remplie en colonne 29 AD est "TBD", la macro renseigne en AE "Fix under development" saurais-tu stp comment le formuler ? J'ai tenté ceci:

      Sub autofill()

      Dim LastrowK As Long, LastrowAE As Long, LastrowAD As Long, cellSolution As Range
      Dim mois As Byte
      Dim trimestre As Byte
      Dim IsDate As Date
      Dim IsString As String

      With Sheets("External TFU-TDO")
      LastrowK = .Cells(.Rows.Count, "K").End(xlUp).Row
      LastrowAE = .Cells(.Rows.Count, "AE").End(xlUp).Row
      LastrowAD = .Cells(.Rows.Count, "AD").End(xlUp).Row
      End With

      ' Autofill of solution availability in QuarterX 201Y way
      ' In any date formats, the macro will run QY 201X
      ' If the date is already in a Quarter format, no change
      ' If it is "N/A" no change
      ' If it is "Available" no change
      ' If it is "TBD", the macro will run "Fix under development"

      For Each cellSolution In Range(Cells(3, 30), Cells(LastrowK, 30))
      If IsDate(cellSolution.Value) Then
      mois = Month(cellSolution.Value)
      trimestre = 1 + (mois - 1) \ 3
      cellSolution.Offset(0, 1).Value = "Q" & trimestre & " " & Year(cellSolution.Value)
      Else
      If IsString(cellSolution.Value) Then
      Select Case cellSolution
      Case Is = "TBD": cellSolution.Offset(0, 1) = "Fix under development"
      End Select
      End If

      Else
      cellSolution.Offset(0, 1).Value = cellSolution.Value

      End If
      Next cellSolution

      End Sub

      Qu'en penses-tu?
      Un grand merci !
    5. michel_m Contributeur
      @michel_mExcusez moi d'avoir déragé encore une fois
  2. ccm81
    Bonjour

    Un petit exemple utilisant IsDate 
    Dim d, m As Long, plage As Range, cel As Range
Set plage = Selection
For Each cel In plage
  d = cel.Value
  If IsDate(d) Then
    m = Month(d)
    Select Case m
      Case Is <= 3: cel.Value = "Q1 " & Year(d)
      Case Is <= 6: cel.Value = "Q2 " & Year(d)
      Case Is <= 9: cel.Value = "Q3 " & Year(d)
      Case Else: cel.Value = "Q4 " & Year(d)
    End Select
  Else
    ' a toi de voir si d n'est pas une date
  End If
Next cel

    Cdlmnt
    1. ccm81
      ou plus simple 
      Public Sub OK()
      Dim d, m As Long, plage As Range, cel As Range
      Set plage = Selection
      For Each cel In plage
        d = cel.Value
        If IsDate(d) Then
          m = Month(d)
          cel.Value = "Q" & 1 + (m - 1) \ 3 & " " & Year(d)
        Else
          ' a toi de voir si d n'est pas une date
        End If
      Next cel
      End Sub

      Cdlmnt
    2. Dianex87 Auteur
      @ccm81Merci bcp de ta réponse,

      Mais comme pour la 1ere reponse, j'ai un msg d'erreur ""Run time error 1004: Application-defined or object-defined error".
      La ligne "Set plage = Range(Cells(3, 30), Cells(LastrowK, 30))" est surlignée en jaune.
      Et en passant mon curseur dessus, je peux lire: "Range(Cells(3,30), Cells(Last...) =<Application defined or object-defined error>. Que signigfie cela ?

      J'ai cru bien faire en changeant cel.Value = "Q1 " & Year(d) en cel.Offset(0, 1).Value = "Q1 " & Year(d) car c'est dans la cellule de droite, meme ligne, que je souhaite avoir mon format QX 201Y.

      Sub autofill()

      Dim d, m As Long, plage As Range, cel As Range
      Set plage = Range(Cells(3, 30), Cells(LastrowK, 30))
      For Each cel In plage
      d = cel.Value
      If IsDate(d) Then
      m = Month(d)
      Select Case m
      Case Is <= 3: cel.Offset(0, 1).Value = "Q1 " & Year(d)
      Case Is <= 6: cel.Offset(0, 1).Value = "Q2 " & Year(d)
      Case Is <= 9: cel.Offset(0, 1).Value = "Q3 " & Year(d)
      Case Else: cel.Offset(0, 1).Value = "Q4 " & Year(d)
      End Select
      Else
      cel.Offset(0, 1).Value = cel.Value

      End If
      Next cel

      End Sub

      Une solution?
      Merci encore!
      Dianex87
  3. ccm81
    Set plage = Range(Cells(3, 30), Cells(LastrowK, 30))
    Ici LastrowK n'a pas été affectée donc vaut 0

    RQ. Pour le n° du trimestre tu as plus simple que le Select Case au post 3

    Cdlmnt
    1. Dianex87 Auteur
      Merci ccm81 :)

      Pour répondre à ta remarque, c'est juste que je comprends mieux écrit comme ça plus que la formule cel.Value = "Q" & 1 + (m - 1) \ 3 & " " & Year(d)

      Thx again !

Discussions similaires

convertir des trimestres en ans mois et jours
Cambouie44

6 réponses
Calcul de nbre de nuitees pour ch d'hotes
JCD22580

9 réponses
Calculs des heures de nuits
HunterBlaze

23 réponses
Nombre de nuit pour Hotel
Jamryl

14 réponses