Loop et cells.findnext
Bonjour !
Je progresse doucement avec VBA mais me voilà face à un nouveau problème.
Voici un extrait de mon code, qui me permet de trouver un bordereau en fonction de son montant. Si la date correspond, la case se remplie (cette partie de mon code fonctionne et ne figure pas ici). Si la date ne correspond pas (+ de 7 jours plus tard ou + de 1 jour avant), ma macro devrait chercher le prochain bordereau dont le montant correspond. Or là, ma macro continue à sélectionner le premier bordereau.
'3. Trouver le bordereau correspondant dans Ajustements
Dim Bordereau_trouve As Range
Set Bordereau_trouve = Sheets("Ajustements").Range("D1:D2000").Find(Montant_bordereau, lookat:=xlWhole, searchorder:=xlByRows)
'Recherche le premier bordereau avec le même montant
If Not Bordereau_trouve Is Nothing Then 'Il y a un bordereau correspondant
Dim numligne3 As Integer
numligne3 = Bordereau_trouve.Row
Sheets("Ajustements").Select 'Tout fonctionne jusqu'ici
If Cells(numligne3, 2) > date_emission + 7 Or Cells(numligne3, 2) <= date_emission Then 'si la date du 1er bordereau ne correspond pas (+ de 7 jours plus tard ou + de 1j avant)
MsgBox "ligne suivante à partir de :" & numligne3 ' testé, fonctionne
Do 'ce loop / cells.findnext ne fonctionne pas
Bordereau_trouve = Cells.FindNext(Bordereau_trouve) 'Doit trouver le prochain bordereau avec montant correspondant
Loop While Bordereau_trouve.Row <> numligne3 'pour éviter de tourner en boucle
Bordereau_trouve.SelectVous trouverez ci-joint un fichier avec la bonne date : aller dans Montants compta, cliquer sur le bouton : tout fonctionne.
Fichier avec erreur volontaire dans la date : la macro ne sélectionne pas correctement le row suivant. (il devrait sélectionner la ligne 7 et plus la 6)
Vous trouverez si besoin le code entier dans les fichiers joints mais j'ai préféré ne pas surcharger mon post car il est assez long.
J'imagine qu'il s'agit d'une erreur basique au niveau de mon cells.findnext mais je n'arrive pas à la déceler :). Je trouve peu d'infos sur cette fonction malheureusement.
Merci et bonne journée !
Bonjour,
Je suis en train de retravaillé ton code, j'ai une question cependant, peux-tu m'expliquer concrètement ce que tu cherche à faire à partir du moment où tu confirme cette ligne If Cells(numligne3, 2) > Date_Emission + 7 Or Cells(numligne3, 2) <= Date_Emission Then et concrètement ce que tu veux faire si tu l'infirme ?
EDIT : modification du code à 15:40
Sub Bordereau()
Dim BD As Worksheet
Dim ID As String, CPAM As String, Nom As String
Dim Dernlig As Long, ValID As Long, Lig As Long, Cpt As Long
Dim Montant_Bordereau As Double, Montant_Perso_Info As Double, Montant_Perso_Maj As Double
Dim Date_Emission As Date
Dim Bordereau_Trouve As Range
'******************************
'* Première phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("montants compta")
ValID = ""
Cpt = 0
ID = BD.Range("J1")
Dernlig = BD.Range("A" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If CStr(BD.Cells(i, 1)) = ID Then
Cpt = Cpt + 1
ValID = BD.Cells(i, 6)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub
If ValID = "" Then MsgBox "Montant non trouvé pour le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub
'******************************
'* Seconde phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("IJSS")
cpr = 0
Dernlig = BD.Range("A" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If CStr(BD.Cells(i, 3)) = ID Then
Cpt = Cpt + 1
CPAM = BD.Cells(i, 16)
Nom = BD.Cells(i, 4) & " " & BD.Cells(i, 5)
Date_Emission = BD.Cells(i, 15)
Montant_Bordereau = BD.Cells(i, 17)
Montant_Perso_Info = BD.Cells(i, 18)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule dans IJSS.", vbExclamation, "Erreur": Exit Sub
If Cpt > 1 Then MsgBox "Attention, Plusieurs entrée existe pour le même matricule.", vbExclamation, "Résultats"
'******************************
'* Troisième phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("Ajustements")
Dernlig = BD.Range("A" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If BD.Cells(i, 3) = Montant_Bordereau Then
If CDate(BD.Cells(i, 2)) > Date_Emission + 7 And CDate(BD.Cells(i, 2)) <= Date_Emission Then
'Tu veux faire quoi si VRAI ?
Else
'Tu veux faire quoi si FAUX ?
End If
Next i
End SubBonjour et merci de m'aider,
Pour te répondre : si mon Cells(numligne3, 2) > Date_Emission + 7 Or Cells(numligne3, 2) <= Date_Emission Then
.
est confirmé : cela veut dire que ce n'est pas le bon bordereau (la date n'est pas bonne). Je veux donc renvoyer la prochaine occurence de Bordereau_trouve = Sheets("Ajustements").Range("D1:D2000").Find(Montant_bordereau, lookat:=xlWhole, searchorder:=xlByRows)
Autrement dit dans ce cas précis, les prochaines occurences de 427.9, jusqu'à trouver une occurence dont les dates correspondent. (ici en ligne 7 puisque c'est un cas simplifié)
.
est infirmé : c'est potentiellement le bon bordereau (car la date est bonne) : une boîte de dialogue s'ouvre,
-si je clique sur oui : la cellule se remplit (fonctionne à ce jour),
-je clique sur non : ma macro recherche la prochaine occurence de 427.9 (pas encore fait puisque je n'y arrive pas),
-je clique sur annuler, la macro s'arrête (fonctionne)
.
Voici la suite du code :
'3. Trouver le bordereau correspondant dans Ajustements
Dim Bordereau_trouve As Range
Set Bordereau_trouve = Sheets("Ajustements").Range("D1:D2000").Find(Montant_bordereau, lookat:=xlWhole, searchorder:=xlByRows)
'Recherche le premier bordereau avec le même montant
If Not Bordereau_trouve Is Nothing Then 'Il y a un bordereau correspondant
Dim numligne3 As Integer
numligne3 = Bordereau_trouve.Row
Sheets("Ajustements").Select 'Tout fonctionne jusqu'ici
If Cells(numligne3, 2) > date_emission + 7 Or Cells(numligne3, 2) <= date_emission Then 'si la date du 1er bordereau ne correspond pas (+ de 7 jours plus tard ou + de 1j avant)
MsgBox "ligne suivante à partir de :" & numligne3 ' testé, fonctionne
Do 'problème avec ce DoLoop
Bordereau_trouve = Cells.FindNext(Bordereau_trouve) 'Doit trouver le prochain bordereau avec montant correspondant
Loop While Bordereau_trouve.Row <> numligne3 'pour éviter de tourner en boucle
Bordereau_trouve.Select
Else 'la date correspond
'4. Valider le montant
Rows(numligne3).Interior.ColorIndex = 24
Cells(numligne3, 10).Select
Selection.Interior.ColorIndex = 6 'la cellule cible est mise en valeur
If Montant_perso > montant_perso_info + 3 Then 'Le montant réel total de la personne est supérieur au montant du bordereau : il y a plusieurs bordereaux
MsgBox "attention, il y a sans doute plusieurs bordereaux pour cette personne"
If MsgBox(CPAM & Chr(10) & "Date d'émission: " & date_emission & Chr(10) & "Montant: " & Montant_bordereau & " €" & Chr(10) & Chr(10) & "Montant individuel passé en paie: " & Montant_perso & Chr(10) & Chr(10) & "Valider ce bordereau ?", vbOKCancel) = vbOK Then 'validation du montant
Cells(numligne3, 10) = montant_perso_info
Cells(numligne3, 19) = Nom
Rows(numligne3).Interior.ColorIndex = 6 'passage en jaune pour vérification ultérieure
montant_perso_maj = Montant_perso - montant_perso_info
MsgBox "Il reste à passer " & montant_perso_maj & " € pour cette personne" 'information sur montant restant
End If 'Fin Si msgbox
Else 'S'il n'y a qu'un bordereau
Dim verif
verif = MsgBox(CPAM & Chr(10) & "Date d'émission: " & date_emission & Chr(10) & "Montant: " & Montant_bordereau & " €" & Chr(10) & Chr(10) & "Valider ce bordereau ?", vbYesNoCancel)
If verif = vbYes Then
MsgBox "ok!" 'validation du montant
Cells(numligne3, 10) = montant_perso_info
Cells(numligne3, 19) = Nom
Rows(numligne3).Interior.ColorIndex = xlColorIndexNone 'la case est remplie, la ligne repasse sans remplissage
ElseIf verif = vbNo Then
MsgBox "byebye"
Exit Sub
ElseIf verif = vbCancel Then 'si refus de validation du montant
Rows(numligne3).Interior.ColorIndex = 3
MsgBox "Passer manuellement au cas suivant"
Exit Sub
End If 'fin validation montant
End If 'plusieurs bordereaux
End If 'fin de si date ne correspond pasOkey alors voilà, test le code et dit moi si ça marche comme tu le veux !
Option Explicit
Sub Bordereau()
Dim BD As Worksheet
Dim ID As String, CPAM As String, Nom As String
Dim Dernlig As Long, ValID As Long, Lig As Long, Cpt As Long, i As Long
Dim Montant_Bordereau As Double, Montant_Perso_Info As Double, Montant_Perso_Maj As Double
Dim Montant_Perso As Double
Dim Date_Emission As Date
Dim Bordereau_Trouve As Range
'******************************
'* Première phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("montants compta")
ValID = ""
Cpt = 0
ID = BD.Range("J1")
Dernlig = BD.Range("A" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If CStr(BD.Cells(i, 1)) = ID Then
Cpt = Cpt + 1
ValID = BD.Cells(i, 6)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub
If ValID = "" Then MsgBox "Montant non trouvé pour le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub
'******************************
'* Seconde phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("IJSS")
Cpt = 0
Dernlig = BD.Range("C" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If CStr(BD.Cells(i, 3)) = ID Then
Cpt = Cpt + 1
CPAM = BD.Cells(i, 16)
Nom = BD.Cells(i, 4) & " " & BD.Cells(i, 5)
Date_Emission = BD.Cells(i, 15)
Montant_Bordereau = BD.Cells(i, 17)
Montant_Perso_Info = BD.Cells(i, 18)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule dans IJSS.", vbExclamation, "Erreur": Exit Sub
If Cpt > 1 Then MsgBox "Attention, Plusieurs entrée existe pour le même matricule.", vbExclamation, "Résultats"
'******************************
'* Troisième phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("Ajustements")
Cpt = 0
Dernlig = BD.Range("D" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If BD.Cells(i, 3) = Montant_Bordereau Then
Cpt = Cpt + 1
If CDate(BD.Cells(i, 2)) > Date_Emission + 7 And CDate(BD.Cells(i, 2)) <= Date_Emission Then
'xxx
Else
BD.Range("A" & i & ":S" & i).EntireRow.ColorIndex = 24
BD.Cells(i, 10).Interior.ColorIndex = 6
If Montant_Perso > Montant_Perso + 3 Then
MsgBox "attention, il y a sans doute plusieurs bordereaux pour cette personne"
If MsgBox(CPAM & Chr(10) & "Date d'émission: " & Date_Emission & Chr(10) & "Montant: " & Montant_Bordereau & " €" & Chr(10) & Chr(10) & "Montant individuel passé en paie: " & Montant_Perso & Chr(10) & Chr(10) & "Valider ce bordereau ?", vbOKCancel) = vbOK Then 'validation du montant
MsgBox "okay!" 'validation du montant
BD.Cells(i, 10) = Montant_Perso_Info
BD.Cells(i, 19) = Nom
BD.Range("A" & i & ":S" & i).EntireRow.Interior.ColorIndex = 6
Montant_Perso_Maj = Montant_Perso - Montant_Perso_Info
MsgBox "Il reste à passer " & Montant_Perso_Maj & " € pour cette personne"
End If
Else
If MsgBox(CPAM & Chr(10) & "Date d'émission: " & Date_Emission & Chr(10) & "Montant: " & Montant_Bordereau & " €" & Chr(10) & Chr(10) & "Valider ce bordereau ?", vbYesNoCancel) = vbYes Then 'validation du montant
MsgBox "ok!" 'validation du montant
BD.Cells(i, 10) = Montant_Perso_Info
BD.Cells(i, 19) = Nom
BD.Range("A" & i & ":S" & i).EntireRow.Interior.ColorIndex = xlColorIndexNone
Else 'si refus de validation du montant
BD.Range("A" & i & ":S" & i).EntireRow.Interior.ColorIndex = 3
MsgBox "Passer manuellement au cas suivant"
Exit Sub
End If 'fin validation montant
End If
End If
End If
Next i
If Cpt = 0 Then MsgBox "Pas de bordereau équivalent"
End SubJe me permet de te faire une remarque au passage, il faut vraiment respecter les tabulations quand tu écrits un code, c'est beaucoup plus simple de se relir (et pour nous de t'aider car sinon on passe un temps fou à essayer de comprendre l’enchaînement)
Bonjour et merci d'être revenu vers moi.
Désolé pour le respect des conventions d'écriture, comme tu peux le voir, j'apprends sur le tas et n'avais jamais fait de code aussi long. J'essaierai de faire mieux à l'avenir.
Concernant le code que tu m'as transmis : j'ai une erreur "incompatibilité de type" qui se déclenche quand je le lance. Je n'ai pas réussi à trouver d'où elle venait.
- Autre petite question au sujet du début : (voir annotations)
'******************************
'* Première phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("montants compta")
ValID = ""
Cpt = 0
ID = BD.Range("J1") 'renvoie actuellement un numéro de ligne (1, 2, 3 pour le moment, selon la personne qu'on veut traiter)
Dernlig = BD.Range("A" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If CStr(BD.Cells(i, 1)) = ID Then '(i, 1) sauf erreur de ma part renvoie un matricule, donc il ne peut pas être = à ID ?
Cpt = Cpt + 1
ValID = BD.Cells(i, 6)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub
If ValID = "" Then MsgBox "Montant non trouvé pour le matricule " & ID & ".", vbExclamation, "Erreur": Exit SubMerci et bonne journée !
Met toi directement dans le projet et appui successivement sur F8 pour faire du mode pas à pas et dit moi sur quelle ligne il plante :)
Pas de soucis, je fait la remarque pour quelle sois constructive, on à tous du apprendre un jour ;)
Hello,
Avec le débogage j'ai trouvé où était le souci mais pas vraiment pourquoi.
'******************************
'* Première phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("montants compta")
ValID = "" '<----- ça plantait ici
Cpt = 0
ID = BD.Range("J1")
Dernlig = BD.Range("A" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If CStr(BD.Cells(i, 1)) = ID Then
Cpt = Cpt + 1
ValID = BD.Cells(i, 6)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub
If ValID = "" Then MsgBox "Montant non trouvé pour le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub '<------ et làJ'ai supprimé ces deux lignes (solution de qualité
If ValID = "" Then MsgBox "Montant non trouvé pour le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub
ne devrait jamais se déclencher car la colonne est toujours remplie.
J'ai également corrigé deux autres petits trucs qui posaient problème, et on commence à s'approcher de ce que je voudrais
Mais la ligne If CDate(BD.Cells(i, 2)) > Date_Emission + 7 And CDate(BD.Cells(i, 2)) <= Date_Emission Then
'xxx ne fonctionne pas correctement.
Si je mets le matricule 70 pour rechercher "Delphine" -> il me renvoie la date du 11/04 alors qu'il devrait automatiquement passer à la ligne suivante. Je ne comprends pas car la partie "then" est pourtant bien vide ?
Je te joins le fichier avec le code à jour.Me revoilà !
L'erreur était simplement que If CDate(BD.Cells(i, 2)) > Date_Emission + 7 And CDate(BD.Cells(i, 2)) <= Date_Emission Then 'xxx contenait and et pas or.
Cette partie semble donc maintenant fonctionner !
Problème suivant :
Julien a plusieurs lignes qui le concernent dans l'onglet IJSS. la formule actuelle ne retient que les informations de la dernière ligne.
Pour traiter chaque ligne, il faudrait que la 3e partie du code soit inclue dans la 2e boucle for, pour que chaque ligne entraîne l'ouverture d'une msgbox de validation.
Pour le moment ça flingue tout. Je vais continuer cet après-midi et je reposterai si je suis bloqué
Désolé de multiplier les posts mais je ne peux plus éditer les précédents.
Je suis bloqué sur le problème évoqué précédemment :
Julien a plusieurs lignes qui le concernent dans l'onglet IJSS. la formule actuelle ne retient que les informations de la dernière ligne.
J'aurais besoin que ma troisième phase se déclenche à chaque fois que cette condition de ma phase 2 est remplie, et pas seulement la dernière, si quelqu'un a une piste :
For i = 2 To Dernlig
If BD.Cells(i, 4) = Montant_Bordereau Then
Option Explicit
Sub Bordereau_forum()
Dim BD As Worksheet
Dim ID As String, CPAM As String, Nom As String
Dim Dernlig As Long, ValID As Long, Lig As Long, Cpt As Long, i As Long, j As Long, numligne As Long
Dim Montant_Bordereau As Double, Montant_Perso_bordereau As Double, Montant_perso_indic, Montant_Perso_Maj As Double
Dim Montant_Perso As Double
Dim Date_Emission As Date
Dim Bordereau_Trouve As Range
Dim verif, verif_pls, verif_div_bordereau
'******************************
'* Première phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("montants compta")
Cpt = 0
numligne = BD.Range("J1")
ID = BD.Cells(numligne, 1)
Dernlig = BD.Range("A" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If BD.Cells(i, 1).Row = numligne Then
Cpt = Cpt + 1
Montant_Perso = BD.Cells(i, 6)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule " & ID & ".", vbExclamation, "Erreur": Exit Sub
'******************************
'* Seconde phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("IJSS")
Cpt = 0
Dernlig = BD.Range("C" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If CStr(BD.Cells(i, 3)) = ID Then
Cpt = Cpt + 1
CPAM = BD.Cells(i, 16)
Nom = BD.Cells(i, 4) & " " & BD.Cells(i, 5)
Date_Emission = BD.Cells(i, 15)
Montant_Bordereau = BD.Cells(i, 17)
Montant_Perso_bordereau = BD.Cells(i, 18)
Montant_perso_indic = BD.Cells(i, 28)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule dans IJSS.", vbExclamation, "Erreur": Exit Sub
If Cpt > 1 Then MsgBox "Attention, Plusieurs entrée existe pour le même matricule.", vbExclamation, "Résultats"
'******************************
'* Troisième phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("Ajustements")
Cpt = 0
Dernlig = BD.Range("D" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If BD.Cells(i, 4) = Montant_Bordereau Then
Cpt = Cpt + 1
Sheets("Ajustements").Activate
If CDate(BD.Cells(i, 2)) > Date_Emission + 7 Or CDate(BD.Cells(i, 2)) <= Date_Emission Then
'xxx
MsgBox "Mauvaise date, bordereau suivant"
ElseIf BD.Cells(i, 10) <> "" Then
MsgBox "Autre salarié, bordereau suivant"
Else
BD.Rows(i).Interior.ColorIndex = 24
BD.Cells(i, 10).Interior.ColorIndex = 6
BD.Cells(i, 4).Select
If Montant_Perso > Montant_Perso_bordereau + 3 Then
MsgBox "Attention, il y a sans doute plusieurs bordereaux pour cette personne"
verif_pls = MsgBox(CPAM & Chr(10) & "Date d'émission: " & Date_Emission & Chr(10) & "Montant du bordereau: " & Montant_Bordereau & " €" & Chr(10) & Chr(10) & "Montant individuel passé en paie: " & Montant_Perso & Chr(10) & Chr(10) & "Valider ce bordereau ?", vbYesNoCancel)
If verif_pls = vbYes Then 'validation du montant
MsgBox "okay!" 'validation du montant
BD.Cells(i, 10) = Montant_perso_indic
BD.Cells(i, 19) = Nom
BD.Rows(i).EntireRow.Interior.ColorIndex = 6
Montant_Perso_Maj = Montant_Perso - Montant_perso_indic
MsgBox "Il reste à passer " & Montant_Perso_Maj & " € pour cette personne"
ElseIf verif_pls = vbNo Then
MsgBox "Bordereau suivant"
Rows(i).Interior.ColorIndex = xlColorIndexNone
ElseIf verif_pls = vbCancel Then
Rows(i).Interior.ColorIndex = 3
MsgBox "Passer manuellement au cas suivant"
Exit Sub
End If
ElseIf Montant_Bordereau > Montant_Perso_bordereau Then
MsgBox "Il y a plusieurs personnes sur ce bordereau"
verif_div_bordereau = MsgBox(CPAM & Chr(10) & "Date d'émission: " & Date_Emission & Chr(10) & "Montant du bordereau: " & Montant_Bordereau & " €" & Chr(10) & Chr(10) & "Diviser ce bordereau ?", vbYesNoCancel)
If verif_div_bordereau = vbYes Then
MsgBox "ok!" 'validation du montant
BD.Cells(i, 19).Value = "Bordereau divisé"
Rows(i + 1).Insert
BD.Cells(i + 1, 10).Value = Montant_Perso
BD.Cells(i + 1, 19).Value = "Div"
BD.Cells(i + 1, 20).Value = Nom
BD.Cells(i + 1, 18).Value = Montant_Perso
BD.Cells(i, 18).Value = BD.Cells(i, 18) - Montant_Perso
Rows(i).Interior.ColorIndex = xlColorIndexNone 'la case est remplie, la ligne repasse sans remplissage
Rows(i + 1).Interior.ColorIndex = xlColorIndexNone 'la case est remplie, la ligne repasse sans remplissage
BD.Cells(i, 18).Font.ColorIndex = 8
BD.Cells(i, 19).Font.ColorIndex = 8
ElseIf verif_div_bordereau = vbNo Then
ElseIf verif_div_bordereau = vbCancel Then
End If
Else
verif = MsgBox(CPAM & Chr(10) & "Date d'émission: " & Date_Emission & Chr(10) & "Montant du bordereau: " & Montant_Bordereau & " €" & Chr(10) & Chr(10) & "Valider ce bordereau ?", vbYesNoCancel)
If verif = vbYes Then
MsgBox "ok!" 'validation du montant
BD.Cells(i, 10) = Montant_Perso
BD.Cells(i, 19) = Nom
Rows(i).Interior.ColorIndex = xlColorIndexNone 'la case est remplie, la ligne repasse sans remplissage
Exit Sub
ElseIf verif = vbNo Then
MsgBox "Bordereau suivant"
Rows(i).Interior.ColorIndex = xlColorIndexNone '
ElseIf verif = vbCancel Then 'si refus de validation du montant
Rows(i).Interior.ColorIndex = 3
MsgBox "Passer manuellement au cas suivant"
Exit Sub
End If 'fin validation montant
End If
End If
End If
Next i
If Cpt = 0 Then MsgBox "Pas de bordereau équivalent"
End SubMerci d'avance !
Tu veux donc dire quand If CStr(BD.Cells(i, 3)) = ID Then est vrai alors tu veux lancer la troisième partie du code ?
Hello,
C'est la solution que je vois, pour que quand j'ai plusieurs lignes pour la même personne (Julien ou Roberte dans mon exemple) la macro traite chaque ligne au lieu de ne garder que la dernière, puisque le fait d'avoir la partie 2 en boucle séparée fait qu'on ne garde que la dernière occurrence de "ID" dans ma liste.
'******************************
'* Seconde phase du code *
'******************************
Set BD = ThisWorkbook.Worksheets("IJSS")
Cpt = 0
Dernlig = BD.Range("C" & BD.Rows.Count).End(xlUp).Row
For i = 2 To Dernlig
If CStr(BD.Cells(i, 3)) = ID Then
Cpt = Cpt + 1
CPAM = BD.Cells(i, 16)
Nom = BD.Cells(i, 4) & " " & BD.Cells(i, 5)
Date_Emission = BD.Cells(i, 15)
Montant_Bordereau = BD.Cells(i, 17)
Montant_Perso_bordereau = BD.Cells(i, 18)
Montant_perso_indic = BD.Cells(i, 28)
End If
Next i
If Cpt = 0 Then MsgBox "Impossible de trouver le matricule dans IJSS.", vbExclamation, "Erreur": Exit Sub
If Cpt > 1 Then MsgBox "Attention, Plusieurs entrée existe pour le même matricule.", vbExclamation, "Résultats"Mais il est tout à fait possible qu'il y ait un autre moyen que je n'ai pas envisagé.
Du coup j'ai imbriqué la partie 3 du code dans la boucle de la partie 2.
Je me permet une remarque, on évite d'utiliser Sheet("toto").Activate pour réaliser une action sur une feuille. Suit ma méthode qui consiste à déclarer une variable qui désigne ta feuille et après tu utilises cette variable pour préciser où le code doit_être exécuté. Dit toi que c'est comme une adresse postale et que le code en a besoin pour savoir où il doit travailler. "Tu dois aller sur la feuille toto, sur la ligne 25 colonne 12 et à cette endroit tu colories la cellule en jaune", si tu met juste "ligne 25 colonne 12 et à cette endroit tu colorie la cellule en jaune" excel ne sait pas sur quelle feuille travailler (par défaut la feuille active)
Si tu ne met que Rows(j + 1).Insert ce n'est pas gênant si tu n'à qu'une feuille dans ton classeur, dans nôtre cas il faut faire BD2.Rows(j + 1).Insert