Travailler sur une grille

Bonjour,

Je possède un fichier Excel avec des grilles de numéros que je dois traiter suivant l'arrivée de données.

en ce qui concerne les données tout va bien pas de problème.

par contre pour traiter chaque tableau j'ai besoin de faire 3 macros :

une pour la suppression, une pour un reset partiel et une pour un reset total.

et là je sui dans la galère depuis deux jour et je n'arrive pas à m'en sortir.

je vous ai mis un exemple dans un fichier avec les explications.

alors si un âme charitable a le temps pour m'aider ce serait le bonheur.

Bien cordialement,

Daniel

Bonjour DANVAL

Bonjour DANVAL ,

Un essai dans le fichier joint.

Les codes des macro1, macro2 et macro3 sont dans le module de la feuille "Feuil1".

La macro1 se déclenche quand on change la valeur de A1. Les autres macros à la demande avec les deux boutons.

Le code :

Option Explicit
Const addrSuppr = "a1", addrmax = "a4"
Const addrGrilA = "c1:f9", addrGrilB = "i1:m9"

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a1")) Is Nothing Then macro1
End Sub

Sub macro1()
Dim t, r, cellSuppr, cellmax, i&, j&
   t = Range(addrGrilA): r = Range(addrGrilB): cellSuppr = Range(addrSuppr): cellmax = Range(addrmax)
   For i = 1 To UBound(t): For j = 1 To UBound(t, 2)
      If r(i, j) = cellSuppr Then r(i, j) = Empty: r(i, UBound(r, 2)) = r(i, UBound(r, 2)) + 1
   Next j, i
   Application.EnableEvents = False: Range(addrGrilB) = r: Application.EnableEvents = True
End Sub

Sub macro2()
Dim t, r, cellSuppr, cellmax, i&, j&
   t = Range(addrGrilA): r = Range(addrGrilB): cellSuppr = Range(addrSuppr): cellmax = Range(addrmax)
   For i = 1 To UBound(r)
      If r(i, UBound(r, 2)) >= cellmax Then
         For j = 1 To UBound(t, 2)
            r(i, j) = t(i, j)
         Next j
         r(i, UBound(r, 2)) = 0
      End If
   Next i
   Application.EnableEvents = False: Range(addrGrilB) = r: Application.EnableEvents = True
End Sub

Sub macro3()
   Application.EnableEvents = False
   Range(addrGrilB).Resize(, Range(addrGrilB).Columns.Count - 1) = Range(addrGrilA).Value
   Range(addrGrilB).Columns(5) = 0
   Application.EnableEvents = True
End Sub

doublon

doublon

bonjour,

bizarre, j'ai des problèmes pour envoyer une réponse, et alors, je l'ai envoyé 2 fois, mais le site est très "busy" ... pfff

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim c As Range, c0 As Range, b As Boolean
     Set c = Intersect(Target, Range("A1"))  'suppression individuel
     If Not c Is Nothing Then
          b = True
          Application.EnableEvents = False
          If Len(c.Value) > 0 Then
               Set c0 = Range("I1:L9").Find(Range("A1"), lookat:=xlWhole, LookIn:=xlValues)
               If Not c0 Is Nothing Then
                    c0.Offset(, 13 - c0.Column).Value = Range("A1").Value
                    c0.ClearContents
               End If
          End If
     End If

     Set c = Intersect(Target, Range("A4"))
     If Not c Is Nothing Then
          b = True
          Application.EnableEvents = False
          If Len(c.Value) > 0 Then
               If StrComp(c.Value, "T", 1) = 0 Then     'reset total
                    Range("I1:L9").Value = Range("C1:F9").Value
                    Range("M1:M9").ClearContents
               Else                          'reset partiel
                    Set c0 = Range("I1:M9").Find(Range("A1"), lookat:=xlWhole, LookIn:=xlValues)
                    If Not c0 Is Nothing Then
                         c0.Offset(, 9 - c0.Column).Resize(, 4).Value = c0.Offset(, 3 - c0.Column).Resize(, 4).Value
                         c0.Offset(, 12 - c0.Column).ClearContents
                    End If
               End If
          End If

     End If

     If b Then
          Range("A1,A4").ClearContents
          Application.EnableEvents = True
     End If

End Sub

Bonjour,

Formidable c'est exactement ce que je voulais un super grand merci.