Code VBA pour remplir des cases si d'autres sont non vide

Bonjour,

Existe t'il une solution pour remplir des cases avec une certaine valeur si d'autres sont remplies ?

J'ai des horaires sur 2 plannings de B9 à E13; I9 à L13 de (format 00:00) et j'aimerais que si dans certaines de ces cellules des horaires existent alors il faut remplir les autres par 00:00 (toujours dans B9 à E 13) sinon il faut laisser vide.

J'ai trouvé un code vba pour mettre 00:00 dans les cellules vides mais je n'arrive pas à vérifier qu'il ne faut rien mettre s'il n'y a aucune valeur dans la plage concernée

et un deuxieme code pour vérifier s'il y a des valeurs. Je tente de fusionner les 2 codes ....

Public Sub TruncateSmallValuesInDataArea()
   Dim dataArea As Excel.Range
   Set dataArea = ThisWorkbook.Worksheets("Parametres").Range("B9:E13")

   Dim valuesArray() As Variant
   valuesArray = dataArea.Value

   Dim rowIndex As Long
   Dim columnIndex As Long
   For rowIndex = LBound(valuesArray, 1) To UBound(valuesArray, 1)
      For columnIndex = LBound(valuesArray, 2) To UBound(valuesArray, 2)
            If IsEmpty(valuesArray(rowIndex, columnIndex)) Then
            valuesArray(rowIndex, columnIndex) = 0
         End If
      Next
   Next

   dataArea.Value = valuesArray
End Sub

Et sur ce deuxième code il faudrait donc que si tableau vide bah on laisse vide mais par contre si valeurs dans tableau on remplace les vide par 00:00

Sub rempli()
Dim nbval As Long
Range(Cells(9, 2), Cells(13, 5)).Select

nbval = WorksheetFunction.Count(Selection) ' nombre de valeurs

If nbval = 0 Then
MsgBox ("Tableau vide ")
Else
MsgBox ("Tableau rempli ")
End If

End Sub

Merci

Bon je misère à créer ce code vba ^^

Un fichier d'exemple ?

Voilà c'est effectivement peut etre plus simple

Bonjour,

j'ai trouvé une solution qui fonctionne mais qui est surement perfectible ..... car déjà je sélectionne 2 fois les cellules

Maintenant il faut que je ^puisse faire ça sur 4 sélections à la place d'une seul

Sub rempli()
Dim nbval As Long
Range(Cells(9, 2), Cells(13, 5)).Select

nbval = WorksheetFunction.Count(Selection) ' nombre de valeurs

If nbval = 0 Then
MsgBox ("Tableau vide ")
Else
   Dim dataArea As Excel.Range
   Set dataArea = ThisWorkbook.Worksheets("Parametres").Range("B9:E13")

   Dim valuesArray() As Variant
   valuesArray = dataArea.Value

   Dim rowIndex As Long
   Dim columnIndex As Long
   For rowIndex = LBound(valuesArray, 1) To UBound(valuesArray, 1)
      For columnIndex = LBound(valuesArray, 2) To UBound(valuesArray, 2)
            If IsEmpty(valuesArray(rowIndex, columnIndex)) Then
            valuesArray(rowIndex, columnIndex) = 0
         End If
      Next
   Next

   dataArea.Value = valuesArray
End If

End Sub

Bon j'ai réussi mais ce n'est pas parfait, il faut que je trouve comme éviter de dupliquer 4 fois les mêmes actions

Si quelqu'un peut m'aider à le simplifier

Sub rempli()
Dim nbval As Long
   Sheets("Parametres").Activate
   Application.Range("B9:E13").Select

nbval = WorksheetFunction.Count(Selection) ' nombre de valeurs

If nbval = 0 Then

Else
   Dim rng1 As Excel.Range
   Set rng1 = Application.Range("B9:E13")
   Dim valuesArray() As Variant
   valuesArray = rng1.Value

   Dim rowIndex As Long
   Dim columnIndex As Long
   For rowIndex = LBound(valuesArray, 1) To UBound(valuesArray, 1)
      For columnIndex = LBound(valuesArray, 2) To UBound(valuesArray, 2)
            If IsEmpty(valuesArray(rowIndex, columnIndex)) Then
            valuesArray(rowIndex, columnIndex) = 0
         End If
      Next
   Next

   rng1.Value = valuesArray

End If

Dim nbval2 As Long
   Sheets("Parametres").Activate
   Application.Range("I9:L13").Select

nbval2 = WorksheetFunction.Count(Selection) ' nombre de valeurs

If nbval2 = 0 Then

Else
   Dim rng2 As Excel.Range
   Set rng2 = Application.Range("I9:L13")
   Dim valuesArray2() As Variant
   valuesArray2 = rng2.Value

   Dim rowIndex2 As Long
   Dim columnIndex2 As Long
   For rowIndex2 = LBound(valuesArray2, 1) To UBound(valuesArray2, 1)
      For columnIndex2 = LBound(valuesArray2, 2) To UBound(valuesArray2, 2)
            If IsEmpty(valuesArray2(rowIndex2, columnIndex2)) Then
            valuesArray2(rowIndex2, columnIndex2) = 0
         End If
      Next
   Next

   rng2.Value = valuesArray2

End If

Dim nbval3 As Long
   Sheets("Parametres").Activate
   Application.Range("B19:E23").Select

nbval3 = WorksheetFunction.Count(Selection) ' nombre de valeurs

If nbval3 = 0 Then

Else
   Dim rng3 As Excel.Range
   Set rng3 = Application.Range("B19:E23")
   Dim valuesArray3() As Variant
   valuesArray3 = rng3.Value

   Dim rowIndex3 As Long
   Dim columnIndex3 As Long
   For rowIndex3 = LBound(valuesArray3, 1) To UBound(valuesArray3, 1)
      For columnIndex3 = LBound(valuesArray3, 2) To UBound(valuesArray3, 2)
            If IsEmpty(valuesArray3(rowIndex3, columnIndex3)) Then
            valuesArray3(rowIndex3, columnIndex3) = 0
         End If
      Next
   Next

   rng3.Value = valuesArray3

End If

Dim nbval4 As Long
   Sheets("Parametres").Activate
   Application.Range("I19:L23").Select

nbval4 = WorksheetFunction.Count(Selection) ' nombre de valeurs

If nbval4 = 0 Then

Else
   Dim rng4 As Excel.Range
   Set rng4 = Application.Range("I19:L23")
   Dim valuesArray4() As Variant
   valuesArray4 = rng4.Value

   Dim rowIndex4 As Long
   Dim columnIndex4 As Long
   For rowIndex4 = LBound(valuesArray4, 1) To UBound(valuesArray4, 1)
      For columnIndex4 = LBound(valuesArray4, 2) To UBound(valuesArray4, 2)
            If IsEmpty(valuesArray4(rowIndex4, columnIndex4)) Then
            valuesArray4(rowIndex4, columnIndex4) = 0
         End If
      Next
   Next

   rng4.Value = valuesArray4

End If
End Sub

Bonjour,

si j'ai bien compris :

Sub rempli()
    Const tabl = "B9:E13,I9:L13,B19:E23,B19:E23"
    Dim pl As Range, nb As Long, tmp, i As Long
    tmp = Split(tabl, ",")
    For i = 0 To UBound(tmp)
        Set pl = Range(tmp(i))
        nb = WorksheetFunction.Count(pl)
        If nb > 0 And nb < pl.Count Then
            Set pl = pl.SpecialCells(xlCellTypeBlanks)
            If Not pl Is Nothing Then pl = 0
        End If
    Next i
End Sub

eric
PS: en théorie tu devrais pouvoir enlever la ligne If Not pl Is Nothing Then pl = 0 car pl ne sera jamais Nothing
J'ai préférer la laisser que tu saches que c'est un test à faire systématiquement avec SpecialCells (sauf ici car je suis sûr du résultat...)

Merci pour vos réponses.

Comme énoncé je regarde le code, j'apprends le fonctionnement du vba mais ça demande du temps donc je teste.

Et avant d'aller modifier un code déjà écrit j'essaie de comprendre tout son fonctionnement.

Donc effectivement la modification était très simple

Je me documente je me documente.....Je pensais prendre un libre si quelqu'un à une référence à me conseiller

Merci encore et bonne journée

Re,

autre chose oubliée si un jour tu ré-utilises .SpecialCells
Il génère une erreur s'il ne trouve pas de cellules correspondantes. Il faut donc traiter cette erreur

On Error Resume Next
Set pl = pl.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0

non mis ici car, comme dit précédemment, il trouvera toujours au moins 1 cellule vide vu que je teste nb > 0 And nb < pl.Count
eric