Discussion :

[INFINITY100]

Bonjour à tous

Voila ma question est simple j'ai la macro ci-dessous qui fonctionne très bien le seule soucis je la trouve trop longue donc existe t-il un moyen de la rendre simple le maximum possible

Voici ma 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
Sub Extraire()
  [b12:g1048576].Clear
  Sheets("BD_DettesRéglements").Range("B11:G1048576").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("F_Dettes_Réglements!Criteria"), CopyToRange:=Range("B11:G11")
  [G1048576].End(xlUp).Offset(1, 0).Select
  ActiveCell.Offset(, -1) = "Total"
  If ActiveCell.Row > 12 Then
     ActiveCell = "=SUM(G12:G" & ActiveCell.Offset(-1, 0).Row & ")"
  End If
  '---- présentation
  derlig = [d1048576].End(xlUp).Row
  For lig = 12 To derlig
    With Cells(lig, "b").Resize(, 6)
        .Interior.ColorIndex = 19
        .Borders.LineStyle = xlContinuous
        If Cells(lig, "d").Value = "Dette" Then
            .Font.ColorIndex = 3
        ElseIf Cells(lig, "d").Value = "Règlement" Then
            .Font.ColorIndex = 5
        End If
    End With
  Next lig
  Set champ = Cells(derlig, "f").Offset(1, 0)
  champ.Borders.LineStyle = xlContinuous
  champ.HorizontalAlignment = xlGeneral
  champ.HorizontalAlignment = xlCenter
  champ.VerticalAlignment = xlCenter
  champ.Interior.ColorIndex = 6
  champ.Font.Bold = True
  With champ.Font
  .Name = "Arial"
  .Size = 12
  End With
  Set champ2 = Cells(derlig, "f").Offset(1, 1)
  champ2.Borders.LineStyle = xlContinuous
  champ2.HorizontalAlignment = xlGeneral
  champ2.VerticalAlignment = xlCenter
  champ2.Interior.ColorIndex = 6
  champ2.Font.Bold = True
  With champ2.Font
  .Name = "Arial"
  .Size = 12
  End With
  Range("A1").Select
End Sub

Merci mes amis

Cordialement

[tamtam64]

l'enregistrement de macro.....
je pense pas que l'on puisse raccourcir significativement ce code car il ya bcp de petites taches et de conditions donc tu est obligé de les executé. On peut souvent raccourcir quand ce sont des fonctions deja existantes ou que la tache se repete, ca c'est principalement des petites taches bien precises.
Dsl peut etre quelqu'un de bien meilleur te proposera eventuellement de revoir carrement le code .

[joe.levrai]

je laisse les 5 ou 6 ligne qu'on peut encore gagner à d'autres

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
Sub Extraire()
[b12:g1048576].Clear
Sheets("BD_DettesRéglements").Range("B11:G1048576").AdvancedFilter Action:=xlFilterCopy, _
      CriteriaRange:=Range("F_Dettes_Réglements!Criteria"), CopyToRange:=Range("B11:G11")
[G1048576].End(xlUp).Offset(1, 0).Select
ActiveCell.Offset(, -1) = "Total"
If ActiveCell.Row > 12 Then
   ActiveCell = "=SUM(G12:G" & ActiveCell.Offset(-1, 0).Row & ")"
End If
'---- présentation
derlig = [d1048576].End(xlUp).Row
For lig = 12 To derlig
  With Cells(lig, "b").Resize(, 6)
      .Interior.ColorIndex = 19
      .Borders.LineStyle = xlContinuous
      If Cells(lig, "d").Value = "Dette" Then
          .Font.ColorIndex = 3
      ElseIf Cells(lig, "d").Value = "Règlement" Then
          .Font.ColorIndex = 5
      End If
  End With
Next lig
For i = 0 To 1
    Set champ = Cells(derlig, "f").Offset(1, i)
    With champ
        .Borders.LineStyle = xlContinuous
        .HorizontalAlignment = xlGeneral
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Interior.ColorIndex = 6
        .Font.Bold = True
        With .Font
            .Name = "Arial"
            .Size = 12
        End With
    End With
Next i
Range("A1").Select
End Sub