Microsoft 365 Optimisation code vba (remplissage automatique sous condition)

pamonnier · 2 Décembre 2022

Bonsoir

J’ai réussi à faire un code qui fonctionne mais il est sûrement optimisable car je répète 4 fois le codes pour 4 Range différentes.
Si quelqu’un a des pistes pour le raccourcir.
Il me permet de vérifier s’il y a des valeurs dans une plage et s’il y a des valeurs il met des 0 dans les cellules vides sinon il laisse vide.

Ensuite je n’arrive pas à ce que ce code ne se fasse que sur une page spécifique même si je suis pas dessus… la page où doit s’exécuter le code est « Parametres »

J’ai tenté plusieurs solutions mais échec.

En vous remerciant

VB:

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

vgendron · 2 Décembre 2022

Bonjour

il te suffit de placer le code "redondant" dans une macro que tu appelles autant de fois que de zone à traiter

VB:

Sub rempli()

With Sheets("Parametres")
    .Activate
    Traitement .Range("B9:E13")
    Traitement .Range("I9:L13")
    Traitement .Range("B19:E23")
    Traitement .Range("I19:L23")
End With
   
End Sub
Sub Traitement(Zone As Range)
Dim valuesArray() As Variant
Dim rowIndex As Long
Dim columnIndex As Long

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

If nbval = 0 Then Exit Sub

valuesArray = Zone.Value

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 columnIndex
Next rowIndex

Zone.Value = valuesArray

End Sub

p56 · 2 Décembre 2022

Bonsoir à tous,
Oulà!
S'il s'agit encore du même fichier, pour tester les 4 plages "Theo" (si vides ou non) il suffit d'écrire :

VB:

For i = 1 To 4
    If Not Application.Count(Theo(i)) = 0 Then md = i
Next i

(dans la boucle for existante de la Sub Remplir_Prev)

pamonnier · 3 Décembre 2022

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

mapomme · 3 Décembre 2022

Bonjour à @pamonnier , @vgendron , @p56 ,

Un code un peu plus court avec :

Une procédure Remplir_Si_un_Nombre_Au_moins() qui ne traite une plage que si cette plage contient au moins un nombre (on prend en compte les conditions du genre If nbval = 0 ...)
Une procédure Remplir_Tout() qui ne prend pas en compte la condition énoncée ci-dessus
et une procédure INIT() qui rétablit les plages à leur état initial.

Cliquez sur les boutons en couleurs poiur tester.

Le code est dans Module1 :

VB:

Sub Remplir_Si_un_Nombre_Au_moins()
Dim xplage
   With Sheets("Parametres")
      For Each xplage In .Range("B9:E13,I9:L13,B19:E23,I19:L23").Areas
         If Application.Count(xplage) > 0 Then xplage.Replace what:="", replacement:=0, lookat:=xlWhole
      Next xplage
   End With
End Sub
   
Sub Remplir_Tout()
   Sheets("Parametres").Range("B9:E13,I9:L13,B19:E23,I19:L23").Replace what:="", replacement:="0", lookat:=xlWhole
End Sub

Sub INIT()
   Sheets("Parametres").Range("B9:E13,I9:L13,B19:E23,I19:L23").Replace what:=0, replacement:="", lookat:=xlWhole
End Sub

pamonnier · 3 Décembre 2022

p56 à dit:
Bonsoir à tous,
Oulà!
S'il s'agit encore du même fichier, pour tester les 4 plages "Theo" (si vides ou non) il suffit d'écrire :

VB:

For i = 1 To 4 If Not Application.Count(Theo(i)) = 0 Then md = i Next i

(dans la boucle for existante de la Sub Remplir_Prev)

Ah mais avec cette modification effectivement plus d'erreur avec les lundi vides mais il fait tourner les 4 plannings même celui qui est vide

Je pars en recherche de solutions merci

@mapomme
Joli merci
Quand je vois celui que j’ai utilisé

VB:

Sub Remplir_Si_un_Nombre_Au_moins()
Dim xplage
   With Sheets("Parametres")
      For Each xplage In .Range("B9:E13,I9:L13,B19:E23,I19:L23").Areas
         If Application.Count(xplage) > 0 Then xplage.Replace what:="", replacement:=0, lookat:=xlWhole
      Next xplage
   End With
End Sub

Microsoft 365 Optimisation code vba (remplissage automatique sous condition)

pamonnier

XLDnaute Junior

vgendron

XLDnaute Barbatruc

p56

XLDnaute Occasionnel

pamonnier

XLDnaute Junior

mapomme

XLDnaute Barbatruc

Pièces jointes

pamonnier

XLDnaute Junior

Discussions similaires