Bonjour à tous,

Ce post pour solliciter votre aide pour modifier une macro afin de l’adapter à l’évolution de besoins.

La macro que je vous livre si dessous a pour objet, dans ses « Etapes 1 & 2 », de traiter un nombre variable de cellules de la colonne C qui constituent une série de nombre. Dans cette série de nombre elle va rechercher ceux compris entre 10.0 et 19.9

Si elle trouve UN SEUL nombre compris entre 10.0 et 19.9, elle va coller le caractère « * » dans la cellule D2 et coller dans la cellule E2 le chiffre contenu dans la cellule de la colonne B qui jouxte la cellule de la colonne C où a été trouvé le seul nombre compris entre 10.0 et 19.9 (Fichier joint Etape 1 = Traitement1)

Si elle ne trouve AUCUN nombre compris entre 10.0 et 19.9, elle va coller la valeur (N) dans la cellule D2. Elle fait de même si elle trouve PLUS DE UN nombre compris entre 10.0 et 19.9 (Fichier joint Etape 2.1 & 2.2 = Traitement2)

La modification doit porter uniquement sur l’Etape 2.2 qui ne doit plus consister à appliquer le « Traitement2 » lorsque la série comporte PLUS DE UN nombre compris entre 10.0 et 19.9 mais à apporter un des 2 TRAITEMENTS lorsque la série comporte PLUS DE UN nombre compris entre 10.0 et 19.9 et ce en tenant compte d’éventuelles Egalités.

Il s’agit ici de considérer des « Egalités » lorsque la série comprend PLUS DE UN NOMBRE compris entre 10.0 et 19.9 et de repérer LA PLUS PETITE DIZAINE afin de lui apporter un Traitement différent en fonction des « Egalités ».

On appellera « Dizaines Egales » les nombres appartenant à la même Dizaine quelle que soit le chiffre après la virgule et ainsi seront considérés comme « Dizaines Egales » les Dizaines qui vont 10.0 à 10.9. Il en va de même pour les Dizaines qui vont de 11.0 à 11.9, celles qui vont de 12.0 à 12.9… celles qui vont de 19.0 à 19.9

Par suite, et sachant que les cas de figures où il n’y a pas de Dizaine dans la série ou qu’une seule sont déjà traités dans la macro d’origine :

Si la série comporte SEULEMENT 2 dizaines :

• Les 2 Dizaines sont Egales => « N » en D2 (Fichier joint, Traitement2 déjà compris dans la macro d’origine)
• Les 2 dizaines ne sont pas Egales => « * » en C2 + chiffre contenu dans la cellule de la colonne B qui jouxte la cellule de la colonne C où a été trouvée LA PLUS PETITE des 2 Dizaines (Fichier joint, Traitement 1 déjà compris dans la macro d’origine)

Si la série comporte PLUS DE 2 dizaines :

• AUCUNES des Dizaines ne sont Egales => « * » en C2 + chiffre contenu dans la cellule de la colonne B qui jouxte la cellule de la colonne C où a été trouvée LA PLUS PETITE des 2 Dizaines (Fichier joint Traitement 1)

• SEULEMENT 2 Dizaines sont Egales :
o Si les 2 Dizaines Egales COMPORTENT LA PLUS PETITE DIZAINE => « N » en D2 (Fichier joint Traitement 2)
o Si les 2 Dizaines Egales NE COMPORTENT PAS LA PLUS PETITE DIZAINE => « * » en C2 + chiffre contenu dans la cellule de la colonne B qui jouxte la cellule de la colonne C où a été trouvée LA PLUS PETITE Dizaine (Fichier joint Traitement1)

• PLUSIEURS Dizaines sont Egales :
o Si une des Dizaines Egales COMPORTE LA PLUS PETITE DIZAINE => « N » en D2 (Fichier joint Traitement 2)
o Si les Dizaines Egales NE COMPORTENT PAS LA PLUS PETITE DIZAINE => « * » en C2 + chiffre contenu dans la cellule de la colonne B qui jouxte la cellule de la colonne C où a été trouvée LA PLUS PETITE Dizaine (Fichier joint Traitement 1)

En résumé, il s’agit de repérer dans chaque série de nombres de la colonne C, dans chaque onglet d’un classeur ouvert, la PLUS PETITE DIZAINE, lorsque celle-ci existe ou qu’elle ne fait pas l’objet d’une Egalité afin d’appliquer le « Traitement1 » ou, le « Traitement2 » dans tous les autres cas.

La macro :
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Sub SériesDizaines()
Dim F As Worksheet, ligdeb&, lig&, w As Worksheet, t$, n&, c As Range
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'pour les suppressions de feuille
Set F = Sheets("Base") 'feuille de restitution
ligdeb = 1 '1ère ligne en feuille Base
lig = ligdeb
For Each w In Worksheets
  If w.Name <> F.Name Then
    '---Etapes 1 et 2 étude colonne C---
    w.[C:C].NumberFormat = "General" 'sécurité
    w.[C:C].Replace Chr(160), "", xlPart
    w.[C:C].Replace " ", ""
    w.[C:C].Replace ".", "." 'pour obtenir des valeurs numériques
    n = Application.CountIf(w.[C:C], ">=10") - Application.CountIf(w.[C:C], ">19.9")
    If n = 1 Then
      w.[D2] = "*"
      For Each c In w.[C:C].SpecialCells(xlCellTypeConstants, 1)
        If c >= 10 And c <= 19.9 Then w.[E2] = c(1, 0): Exit For
      Next
    Else
      w.[D2] = "N"
    End If
    '---Etape 3 heure---
    t = Replace(Right(Trim(Replace(LCase(w.[B2]), Chr(160), "")), 5), "h", ":")
    If IsDate(t) Then w.[C2] = CDate(t) Else w.[C2] = ""
    w.[C2].NumberFormat = "hh:mm"
    '---Etape 4 R C---
    t = Trim(Replace(w.[B2], Chr(160), " "))
    If t Like "R# C#*" Then w.[B2] = Left(t, 5)
    '---Etape 5 date---
    t = Right(Trim(Replace(w.[B1], Chr(160), "")), 10)
    If IsDate(t) Then w.[A2] = CDate(t) Else w.[A2] = ""
    w.[A2].NumberFormat = "dd/mm/yyyy"
    '---Etape 6---
    w.Rows(2).Copy F.Cells(lig, 1)
    lig = lig + 1
    w.Delete
  End If
Next
'---Tri des dates/heures---
F.Rows(ligdeb + lig & ":" & F.Rows.Count).Delete
With Intersect(F.Rows(ligdeb & ":" & F.Rows.Count), F.UsedRange)
  .Sort .Columns(1), xlAscending, , .Columns(3), xlAscending, Header:=xlNo
End With
End Sub
Merci d'avance.

Cordialement.