Modification d'une macro

Version imprimable

Bonjour a tout le monde , bonjour le forum

Mes compétences en VBA étant limité, mais j'en apprends tous les jours, je sollicite auprés de vous une aide afin de modifier un code que voici :
Code:

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 Sub carte_de_fidelite() Client = Range("AC8").Value Montant = Range("AC9").Value Sheets("Clients").Select Range("F5").Select Do While ActiveCell.Value <> Client And ActiveCell.Value <> "" ActiveCell.Offset(1, 0).Select Loop If ActiveCell.Value = "" Then MsgBox ("Client non trouvé") Sheets("Facture").Select Exit Sub End If ActiveCell.Offset(0, 1).Value = ActiveCell.Offset(0, 1).Value + 1 ActiveCell.Offset(0, 2).Value = ActiveCell.Offset(0, 2).Value + Montant If ActiveCell.Offset(0, 1) = Range("A3").Value Then Bon = ActiveCell.Offset(0, 2) * Range("D2").Value ActiveCell.Offset(0, 1).Value = 0 ActiveCell.Offset(0, 2).Value = 0 Sheets("Facture").Select MsgBox ("Carte de fidélité complète !!" & Chr(13) & "Remise de 10% : " & Format(Bon, "0.00") & " Euros") End If Sheets("Facture").Select End Sub
Comme vous l'aurez compris, cette macro et pour tenir a jour une carte de fidélité .
La macro travaille avec 2 feuilles "Facture" et "Client"
Quand ma facture est terminée , je lance la macro qui recherche dans la colonne F5 de la feuille "Client" le nom de celui-ci.
Si le nom n'est pas trouvé , retour d'un message " client non trouvé " ligne 12
A l'inverse le calcul s'effectue si le client est trouvé

J'aimerai , si le client n'est pas trouvé dans la colonne F5 de la feuille "Client", que l'ajout se fasse automatiquement car celui-ci est connu par le range effectué depuis ma feuille "Facture" en "AC8".
Quand le client est ajouté, la macro refait la recheche ( afin d'eviter les doublons ) puis attribut au client ce dont il a droit.

J'espére que cela est possible

Merci de votre aide

Bonjour,

Si dessous une idée d'optimisation, pour éviter l'utilisation répéter des Activcell, et qui ajoute le client si inexistant dans la feuille client

Analyse ce code et essais d'adapter la dernière partie de contrôle de fin de remplissage de la carte de fidelité.
Reviens vers nous si difficultés.

Code:

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
Dim StrClient As String
 
Dim Rg As Range
Dim ShClient As Worksheet
Dim shFacture As Worksheet
 
Set ShClient = Sheets("Clients")
Set shFacture = Sheets("Factures")
 
StrClient = shFacture.Range("AC8").Value
 
'Recherche si client existant
Set Rg = ShClient.Range("F:F").Find(what:=StrClient, after:=ShClient.Range("F5"), lookat:=xlWhole)
 
If Rg Is Nothing Then
    'Pas trouvé
    MsgBox ("Client non trouvé : " & StrClient)
    'Ajout du client dans la feuille Client
    Set Rg = ShClient.Range("F" & ShClient.Range("F65536").End(xlUp).Row + 1)
    Rg.Value = StrClient
End If
 
'Ajout les infos sur la carte
ShClient.Range("G" & Rg.Row).Value = ShClient.Range("G" & Rg.Row).Value + 1
ShClient.Range("H" & Rg.Row).Value = ShClient.Range("H" & Rg.Row).Value + shFacture.Range("AC9").Value

A moins que tu souhaites continuer ton code sur les même bases :?

19/01/2012, 12h36
francky62000

Oula , je t'avoue que ton code m'embrouille un peu , j'ai essayé de l'adapter , il fonction ( ajout et addition ) .
Cependant étant un peu contrarié par la facon de faire , l'adaptation avec le reste du code ne m'est pas une tache facile.
En effet , Les cellule "A3" et "D3" de ma feuille "Client" détermine le moment ou le client a sa carte de fidélité pleine et le montant de sa remise
"A3"= nombre de visite que je détermine
"D2"= chiffre de remise en % ( ici 10 ) que je détermine
ex :Aprés 10 passages, il a droit a 10 % de remise sur le montant total de ses prestations

Du coup, je suis un peu perdu lol

A tester

Code:

1
2
3
4
5
6
If ShClient.Range("G" & Rg.Row).Value = ShClient.Range("A3").Value Then
        Bon = ShClient.Range("H" & Rg.Row).Value * ShClient.Range("D2").Value
        ShClient.Range("G" & Rg.Row).Value = 0
        ShClient.Range("H" & Rg.Row).Value = 0
        MsgBox ("Carte de fidélité complète !!" & Chr(13) & "Remise de 10% :  " & Format(Bon, "0.00") & "  Euros")
End If

20/01/2012, 13h06
francky62000

OK, je te remercie, le code fonctionne parfaitement

Merci et a bientôt