Ajouter par VBA somme fixe aux cellules colonne suivant 2 ou 3 critères

**homère** · 07/10/2016, 09h25

Bonjour, .
Je suis sur Windows 10 et Office 2003.
Voici mon problème. J’ai un classeur avec des colonnes de A à I.
Je voudrais par VBA
1°) Ajouter la somme de 10 € au montant des cellules non vides de la colonne G si les cellules correspondantes de la colonne D .ne sont pas vides.
2°) Ajouter à nouveau la somme de 10 € au montant des cellules non vides de la colonne G si les cellules correspondantes de la colonne D .ne sont pas vides et si le contenu des cellules correspondantes de la colonne A est "Double".
3°) Afficher ensuite la feuille complète.
Actuellement je procède manuellement. J'inscris 10 € dans une cellule vide que j’enregistre. J’utilise ensuite le filtre automatique et le collage spécial, Addition.
J’essaie maintenant de faire les mêmes opérations avec un code que je voudrais incorporer dans une macro : je n’y arrive pas. Avec mes remerciements à ceux qui pourront m’aider.

**Jean-Philippe André** · 07/10/2016, 13h24

Bonjour,

je t'encourage a passer dans un premier temps par l'enregistreur de macros
http://fauconnier.developpez.com/tut...istreur-macro/

Une fois le code cree, on devrait avoir une bonne base pour t'aider a le generaliser.

**homère** · 08/10/2016, 17h13

Bonjour Jean-Philippe,
Comme conseillé, j’ai utilisé l’enregistreur de macros. Comme toujours avec l’enregistreur, il y a beaucoup de "select". J’ai intercalé des commentaires pour les parties du code que je comprends et un ? pour celles qui m’échappent. Enfin, reste le problème de la sélection des plages résultant du filtrage. Le code les définit par la cellule début et de fin . Mais d’une opération à l’autre les plages ne sont jamais identiques. Comment faire pour ne sélectionner que les plages filtrées mais toutes les pages filtrées ? Voici donc le code. Il y a encore du travail pour le généraliser et peut-être le rendre plus élégant.
J'aurai bien besoin de ton aide !
Bon week-end
Homère

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
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
Sub Macro1AjouterSomme()
'
' Macro1AjouterSomme Macro
' Macro enregistrée le 07/10/2016 par Ulysse
'
' Touche de raccourci du clavier: Ctrl+Maj+P
 
 
'Avant d'utiliser la macro issue de l'enregistreur on active le Fichier Test :
 Workbooks("Fichier test.xls").Activate
 
  'Insrire 10 € dans la cellule J2 et la mettre dans le presse papier :
  ActiveShhers.Range("J2").Select
    ActiveCell.FormulaR1C1 = "$10"
 
    Range("J2").Select
    Selection.Copy
   'Installer le filtre automatique :
   'et filtrer les cellules "Non Vides" des colonnes D et G :
    Application.CutCopyMode = False
    Selection.AutoFilter
    Selection.AutoFilter Field:=4, Criteria1:="<>"
    Selection.AutoFilter Field:=7, Criteria1:="<>"
     ' ?
     Application.CommandBars("Task Pane").Visible = False
 
    'On remplit le presse-paier (J2=10€)
    Range("J2").Select
    Selection.Copy
 
    'On sélectionne les cellules visibles de la colonne G :
    Range("G2:G16").Select
 
    ' Par collage spécial on ajoute 10 € aux cellules de la colonne G :
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
 
    '?
    ActiveSheet.ShowAllData
 
    'On filtre les cellules non vides de la colonne D :
    Selection.AutoFilter Field:=4, Criteria1:="<>"
 
    'On filire les cellules de la colonne A dont le contenu est "M Mme" :
    Range("A1").Select
    Selection.AutoFilter Field:=1, Criteria1:="M Mme"
 
    'On remplit le presse-paier (J2=10€) :
    Range("J2").Select
    Selection.Copy
 
    'On sélectionne les cellules visibles de la colonne A :
    Range("G2:G14").Select
 
    ' Par collage spécial on ajoute 10 € aux cellules de la colonne G :
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
 
    '?
    ActiveSheet.ShowAllData
    'On s'intéresse aux couples d'adhérents NON abonnés :
    Selection.AutoFilter Field:=1, Criteria1:="M Mme"
    Selection.AutoFilter Field:=6, Criteria1:="="
    ActiveWindow.SmallScroll Down:=-6 '?
     Application.CutCopyMode = False
    ActiveSheet.ShowAllData
    Selection.AutoFilter
End Sub

**AlainTech** · 09/10/2016, 15h46

Bonjour,

J'ai essayé de nettoyer ton code en y ajoutant quelques commentaires.
Je précise que, n'ayant pas de données pour tester, je n'ai pas lancé ce code.
A toi, donc, de l'essayer et de nous donner le résultat.
Le nom de la feuille sur laquelle s'applique ce code est à préciser.

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
47
48
49
50
51
52
53
54
55
Option Explicit
 
Sub Macro1AjouterSomme()
'
' Macro1AjouterSomme Macro
' Macro enregistrée le 07/10/2016 par Ulysse
'
' Touche de raccourci du clavier: Ctrl+Maj+P
  Dim wbk As Workbook
  Dim wks As Worksheet
 
  'Avant d'utiliser la macro issue de l'enregistreur on assigne le Fichier Test à la variable wbk:
  Set wbk = Workbooks("Fichier test.xls")
  ' On assigne la feuille "NomDeLaFeuille" (à adapter) à la variable wks
  Set wks = wbk.Sheets("NomDeLaFeuille")
 
  ' Vu qu'on va travailler sur la feuiile "NomDeLaFeuille", on crée un bloc With / End With
  With wks
    'Insrire 10 € dans la cellule J2 et la mettre dans le presse papier :
    .Range("J2").Value = "$10" ' .Value plutôt que .FormulaR1C1 puisqu'il s'agit d'une valeur et pas une formule
 
    .Range("J2").Copy
    'Installer le filtre automatique :
    'et filtrer les cellules "Non Vides" des colonnes D et G :
    Application.CutCopyMode = False ' Tiens, pourquoi? Ceci annule le Copy précédent
    .Range("J2").AutoFilter Field:=4, Criteria1:="<>", Field:=7, Criteria1:="<>"
 
    'On remplit le presse-paier (J2=10€)
    .Range("J2").Copy
 
    ' Par collage spécial on ajoute 10 € aux cellules de la colonne G :
    .Range("G2:G16").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
 
    'On filtre les cellules non vides de la colonne D :
    .Range("G2:G16").AutoFilter Field:=4, Criteria1:="<>"
 
    'On filire les cellules de la colonne A dont le contenu est "M Mme" :
    .Range("A1").AutoFilter Field:=1, Criteria1:="M Mme"
 
    'On remplit le presse-paier (J2=10€) :
    .Range("J2").Copy
 
    ' Par collage spécial on ajoute 10 € aux cellules de la colonne G :
    .Range("G2:G14").PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
 
    'On s'intéresse aux couples d'adhérents NON abonnés :
    .Range("G2:G14").AutoFilter Field:=1, Criteria1:="M Mme", Field:=6, Criteria1:="="
    Application.CutCopyMode = False
    .ShowAllData
  End With
End Sub

**homère** · 10/10/2016, 15h58

Bonjour Jean-Philippe,
Un grand merci pour le code nettoyé : il fonctionne parfaitement avec le Fichier test.
Il ne me reste plus qu’à l’adapter au fichier réel…mais ça, je sais faire !
Par ailleurs,en explorant le net, j’ai trouvé un bout de code plus élégant qui fonctionne parfaitement pour la première partie du problème :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 Workbooks("Fichier Test.xls").Sheets("Feuil1").Activate
  Dim Cel As Range
    For Each Cel In Range("G2", Range("G" & Rows.Count).End(xlUp))
       If Cel.Offset(, -3).Value <> "" And Cel.Value <> "" Then Cel = Cel.Value + 10
    Next Cel

Mais quand pour la suite, j’écris :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
If Cel.Offset(, -3).Value <> "" And Cel.Value <> "" And Cel.Offset(, -6).Value("M Mme") Then Cel = Cel.Value + 10
    Next Cel

Cette ligne de code s’affiche en jaune et j’ai le message "Erreur 1004 : Erreur définie par l’application ou par l’objet ". Peut-on résoudre cette difficulté ?
Si ce n’est pas le cas, je me contenterai de la macro de l’enregistreur... améliorée par Jean-Philippe.
Avec mes excuses pour cette nouvelle demande.
Bonne fin de journée et encore merci.

**AlainTech** · 10/10/2016, 18h18

Bonjour,

Au cas où tu ne l'aurais pas remarqué, nous sommes plusieurs à te répondre.

Quant à ta dernière question, je suppose que tu es parti de mon code (avec le With) et que tu n'as pas mis de point devant les 2 Range dans

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each Cel In Range("G2", Range("G" & Rows.Count).End(xlUp))

Ce qui donne que VBA ne sait pas à quelle feuille ces Range correspondent.

Ajouter par VBA somme fixe aux cellules colonne suivant 2 ou 3 critères

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager