XL 2019 Date

[le___destin]

Je veux créer une colone d'un tableau lorsque je rempli la premiere case emplie automatiquement les autre cellule jusqu'à la date du fin du moi

 

[le___destin]

Bonsoir Daniel.. je sais que je te gène .. vraiment je vous remerci beaucoup pour votre aide .. tous marche bien maintenant .. just faire ce la apartir de F27 jusqu'a F32 masque tous les ligne contenant "_ _".. merci d'avance Daniel

 

[danielco]

Essaie :

Private Sub Worksheet_Calculate()
  Dim C As Range, ResC As String, Cellule As Range
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  For Each C In Range("F12", Cells(Rows.Count, 6).End(xlUp))
    If C.Offset(, -2) <> "" And C.Offset(, -2) <> ResC Then
      Debug.Print C.Address(0, 0)
      ResC = C
      If Application.CountIf(C.Resize(3), "- -") = 3 And C.Row < 27 Then
        If C.Offset(, 1).Resize(3).MergeCells = False Then
          Application.DisplayAlerts = False
          C.Offset(, 1).Resize(3, 7).Copy Cells(C.Row, 22)
          C.Offset(, 1).Resize(3, 7).Validation.Delete
          C.Offset(, 1).Resize(3, 7).MergeCells = True
          Application.DisplayAlerts = True
        End If
        GoTo Fin
      End If
      If C.Offset(, 1).Resize(3).MergeCells = True Then
        C.Offset(, 1).Resize(3, 7).MergeCells = False
        Cells(C.Row, 22).Resize(3, 7).Copy C.Offset(, 1)
      End If
      For Each Cellule In C.Resize(3)
        If Cellule.Value = "- -" Then
          Cellule.EntireRow.Hidden = True
        Else
          Cellule.EntireRow.Hidden = False
        End If
      Next Cellule
    End If
Fin:
  Next C
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Daniel

 

[le___destin]

bonjour
ca marche mais les lignes F27:F32 reste toujour masque masqué meme si #"- -"

 

[danielco]

C'est ce que tu as demandé, non ?

Daniel

 

[le___destin]

Pas toujour lorsque f27 #"_ _"
La ligne s'affiche

 

[danielco]

Non.

 

[le___destin]

 

[danielco]

On voit juste pas la colonne F ?

Daniel

 

[le___destin]

Si A17 = A18 =0 les lignes sont masque
Apres si A17 et A18 #0 lingne reste masque

 

[le___destin]

Bonjour
Svp trouvez moi solution pour les couleur

 

[danielco]

Vérifie :

Private Sub Worksheet_Calculate()
  Dim C As Range, ResC As String, Cellule As Range, plage As Range
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Set plage = Range("M12", Cells(Rows.Count, 13).End(xlUp)).Offset(, -7)
  Set plage = plage.Resize(plage.Count - 1)
  For Each C In Range("M12", Cells(Rows.Count, 13).End(xlUp)).Offset(, -7)
'    If C.Row = 24 Then Stop
    If C.Offset(, -2) <> "" And C.Offset(, -2) <> ResC Then
      Debug.Print C.Address(0, 0)
      ResC = C
      If Application.CountIf(C.Resize(3), "- -") = 3 And C.Row < 27 Then
        If C.Offset(, 1).Resize(3).MergeCells = False Then
          Application.DisplayAlerts = False
          C.Offset(, 1).Resize(3, 7).Copy Cells(C.Row, 22)
          C.Offset(, 1).Resize(3, 7).Validation.Delete
          C.Offset(, 1).Resize(3, 7).MergeCells = True
          [G42:M44].Copy C.Offset(, 1).Resize(3, 7)
          C.Offset(, 1).Resize(3, 7).Interior.Color = C.Interior.Color
          Application.ScreenUpdating = True
          Application.DisplayAlerts = True
        End If
        GoTo Fin
      End If
      If C.Offset(, 1).Resize(3).MergeCells = True Then
        C.Offset(, 1).Resize(3, 7).MergeCells = False
        Cells(C.Row, 22).Resize(3, 7).Copy C.Offset(, 1)
      End If
      For Each Cellule In C.Resize(3)
    
        If Cellule.Value = "- -" Then
          Cellule.EntireRow.Hidden = True
        Else
          Cellule.EntireRow.Hidden = False
          Application.ScreenUpdating = True
        End If
      Next Cellule
        
    End If
Fin:
  Next C
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub

Daniel

 

[le___destin]

merci beaucoup tout marche bien
vraiment merci Daniel

 

[le___destin]

améliore moi ce code pour que
si( F11:F41) =0 alors L11:L41 =0 dans les autres cellule

 

[le___destin]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

  Dim C As Range
  If Left(Sh.Name, 4) <> "mois" Then Exit Sub
  ActiveSheet.Unprotect "0931"
  If Target.Address = "$D$11" Then
    If Not IsDate(Target(1)) Or Target.Count > 1 Then Exit Sub
    If Day(Target) <> 1 Then Exit Sub
    Application.EnableEvents = False
    [L11:L41,F11:F41].Value = 0
    [D12:D41] = ""
    Rows("12:41").Hidden = False
    With Target.Resize(DateSerial(Year(Target), Month(Target) + 1, 1) - Target)
        .NumberFormat = Target.NumberFormat
        .DataSeries
    End With
    With Application
      If .CountA([D39:D41]) < 3 Then
        Rows(41).Offset(-2 + .CountA([D39:D41])).Resize(3 - .CountA([D39:D41])).Hidden = True
      End If
    End With
    Application.EnableEvents = True
  ElseIf Not Intersect(Target, [L11:L41,F11:F41]) Is Nothing Then
    Application.EnableEvents = False
    For Each C In Intersect(Target, [L11:L41,F11:F41])
      If Application.Weekday(Cells(C.Row, 4), 2) > 5 Then
        C.Value = 0
      End If
    Next C
    Application.EnableEvents = True
    
  End If
  ActiveSheet.Protect "0931"
End Sub

 

[danielco]

Je ne comprends pas ce que tu veux. Ca serait censé remplacer quel code ?

Daniel