adapter macro

christine854

XLDnaute Junior
bonjour a tous

j'ai une macro que je souhaite adapter pour un fichier

j'ai commencé a l'adapté mais je coince sur certains point
voici la macro
Option Explicit

Dim tablo, fb As Worksheet, ft As Worksheet, cell As Range, dte As Date, i&

Sub CONDITION ()
'on defini les variables
Dim Valeur_Test As String
Dim DerniereLigne As Integer
Dim Lig

Set ft = Sheets("TEST_VALIDATION")
Set fb = Sheets("STOCKAGE_DES_DONNEES")
'pour une lecture plus rapide des données dans le tableau résultat
tablo = ft.Range("Q2:Y" & ft.Range("Q" & Rows.Count).End(xlUp).Row)


For i = 2 To UBound(tablo, 1)
Set cell = fb.Range("A2:A" & fb.Range("A" & Rows.Count).End(xlUp).Row).Find(tablo(i, 1), LookAt:=xlWhole)
If Not cell Is Nothing Then
If IsDate(cell.Offset(0, 1)) Then
'Si le test est ok alors on test la Premières condition
If tablo(i, 25) = "L" Or "J" _
And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(cell.Offset(0, 1)), Month(cell.Offset(0, 1)) + 5, 1)

'puis la Deuxièmes conditions
ElseIf tablo(i, 25) = "K" And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then
ft.Range("Q" & i & ":Y" & i).Copy ft.Range("AD" & i)
cell.Offset(0, 1) = "cumule " & cell.Offset(0, 1)

End If

'puis la Troisièmes conditions
ElseIf tablo(i, 19) > 80 And cell.Offset(0, 1) Like "cumule*" Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(Date), Month(Date) + 5, 1)



End If
'on test si l'identifiant existe Sinon, on l'ajoute à la liste avec la date de fin
Else
Cells(DerniereLigne + 1, 1).Value = Valeur_Test
End If

Next i

End Sub


je coince sur : (j'ai mis des commentaire a coté des ligne ou je coince)


For i = 2 To UBound(tablo, 1)
Set cell = fb.Range("A2:A" & fb.Range("A" & Rows.Count).End(xlUp).Row).Find(tablo(i, 1), LookAt:=xlWhole)
If Not cell Is Nothing Then
If IsDate(cell.Offset(0, 1)) Then


If tablo(i, 25) = "L" Or "J" _
And Month(cell.Offset(0, 1)) = Month(Date) _ 'doit tester dans la feuille fb
And Year(cell.Offset(0, 1)) = Year(Date) Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(cell.Offset(0, 1)), Month(cell.Offset(0, 1)) + 5, 1) 'doit saisir dans la feuille fb


ElseIf tablo(i, 25) = "K" And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then 'la date est dans la feuille fb
ft.Range("Q" & i & ":Y" & i).Copy ft.Range("AD" & i)
cell.Offset(0, 1) = "cumule " & cell.Offset(0, 1) 'doit être saisie dans la feuille fb


ElseIf tablo(i, 19) > 80 And cell.Offset(0, 1) Like "cumule*" Then 'cumule est dans la feuille fb
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(Date), Month(Date) + 5, 1) 'saisie de la date dans la feuille fb

la ou j'ai mis des commentaires c'est là ou j'ai mes données mais je ne suis pas sur que dans les conditions ça correspond bien
 

christine854

XLDnaute Junior
bonjour Modeste
alors une bonne et une mauvaise nouvelle (on va commencer par la mauvaise au moins c'est fait )
tu va me détester !!!
j'ai oublié un ptit point de détaille sur la partie "cumule" (j'ai fait la modif dans le schéma, en rouge)
c'est juste un copier coller oublié
la bonne nouvelle est que mis a part cette partie copier coller tout est nickel et que c'est la toutes dernière chose que je te demande après cette correction c'est fini !!
upload_2016-11-12_17-40-31.jpeg
je doit être la pire demande que tu ais eu a traiter :(

Après ça je ne t’embêterai plus :)
En tout cas je tenais a te remercier pour tout le temps et la patience (c'est rien de le dire ) que as accordé a mon (mes) problème, mille, mille merci
 

Pièces jointes

  • Copie de Copie de Schéma logique (christine854).xlsx
    17.3 KB · Affichages: 58

Modeste

XLDnaute Barbatruc
Bonsoir Madame,

Je suis la fille de celui que vous connaissez sous le pseudo de "Modeste" ... à la lecture de votre message tout à l'heure, notre pauvre vieux papa a poussé un cri terrifiant (un peu comme la plainte lugubre d'un animal blessé), puis il a ouvert la fenêtre ... et il a sauté!
Fort heureusement, au moment des faits, il était au rez-de-chaussée! Seuls son amour-propre et l'hortensia qui vivotait sous la fenêtre sont blessés. Sa santé mentale semble vaciller et le médecin consulté en urgence a prescrit un arrêt immédiat de ces échanges bizarres que papa avait avec vous sur ce curieux forum.
Je crains qu'il ne vous faille vous débrouiller sans lui pendant un certain temps. Il reste assis par terre depuis quelques heures et un filet de bave -ma foi fort peu élégant (lui qui était si soigneux de sa personne!) est le seul témoignage d'une activité quelconque ... laquelle ne semble guère très cérébrale (lui qui prenait -aussi- grand soin de ses deux derniers neurones!)
Je vous laisse, Madame, son CD de Chantal G. est terminé: il faut vite que je le remette au début
 

Modeste

XLDnaute Barbatruc
Le schéma "logique" n'en est pas vraiment un: tu as repris une ancienne version et fait des copier-coller sans trop te tracasser. On se retrouve avec le fameux test sur les dates du mois précédent à des endroits différents dans les "branches" pour les 'J' et les 'L' :eek:
Nous ne disposons toujours pas d'un fichier actualisé où faire des tests, ni d'exemple de résultats attendus, sur base de ce fichier :mad:

Dans la partie avec le commentaire: "traitement des lignes avec mention cumule", essaie en remplaçant:
VB:
If .Cells(ligneID, 3) = "cumule" And .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) - 1, 1) Then
    .Cells(ligneID, 3) = ""
    .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) + 3, 1)
End If
... par:
VB:
If .Cells(ligneID, 3) = "cumule" And .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) - 1, 1) Then
    .Cells(ligneID, 3) = ""
    .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) + 3, 1)
    If tabloValid(i, 9) = "L" Then
       For x = 1 To 8
           tabloL(ligL, x) = tabloValid(i, x)
       Next x
       ligL = ligL + 1
    ElseIf tabloValid(i, 9) = "J" Then
       For x = 1 To 8
           tabloJ(ligJ, x) = tabloValid(i, x)
       Next x
       ligJ = ligJ + 1
    End If
End If
 

Discussions similaires

Statistiques des forums

Discussions
311 721
Messages
2 081 929
Membres
101 843
dernier inscrit
Thaly