adapter macro

christine854 · 9 Octobre 2016

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 · 16 Octobre 2016

si tu veut que je reprenne certain point pour que ce soit plus clair demande

Modeste · 16 Octobre 2016

christine854 à dit:
si tu veut que je reprenne certain point pour que ce soit plus clair demande

Oh ouiiiiii

Tu peux reprendre ... tout?

Non, blague à part, tu pourrais reprendre sous la forme d'un ordinogramme, d'un arbre logique ou n'importe quoi qui permettrait de comprendre (et t'obligerait peut-être à formuler et formaliser?) le processus?
Par exemple, tu n'as pas répondu à ma question sur IsDate et donc je ne sais pas où figure le End If qui lui est associé!? Après le deuxième ElseIf ... ou le troisième?
Le test avec tablo(i, 3) > 80 ... tu l'as expliqué quelque part? Au stade actuel c'est cette partie du code qui s'exécute si la colonne C ne contient pas de date. C'est bien ce que tu veux? Dans ton exemple, il y a des dates à chaque ligne, en colonne B, mais ton IsDate examine la colonne C. Enfin, bref, je n'arrive pas à comprendre! (encore une fois, tu peux attendre: peut-être que quelqu'un y arrivera!?)

Quant à "il ne peut pas avoir d'autre données (ou de cas particulier) les données ne peuvent être que sous le format dans le fichier " ... si tu savais le nombre de fois que je l'ai déjà entendu

Il y aura aussi un problème avec ton test sur les mois et les années, mais attendons d'y voir plus clair!

Chaque fois que tu postes, je passe au moins 20 minutes à essayer de m'y retrouver ... et j'ai vraiment un tas de choses à faire, le seul dimanche que compte la semaine

christine854 · 16 Octobre 2016

je te fait ça dans la demi heure

je pense que la macro ne correspond plus entièrement au modification que j'ai apportée suite a tes remarques (pertinentes)
Le test avec tablo(i, 3) > 80 n'a plus lieu d'être

christine854 · 16 Octobre 2016

voila je t'ai fait un arbre logique (enfin un truc qui ressemble) dans la feuille 1 du classeur

christine854 · 16 Octobre 2016

J'ai juste oubliée un truc c'est si l'identifiant n'est pas dans la liste (colonne A de la feuille "stockage de données")
alors il faudrait le rajouter a la fin de la liste avec en colonne B la date (format mm/yyyy) du mois en cours + 3

Modeste · 16 Octobre 2016

christine854 à dit:
voila je t'ai fait un arbre logique

Doux Jésus !!!
M'étonne pas que j'avais un peu de mal à comprendre!
Voici en retour quelques réflexions/questions sur base de ton schéma. Merci d'en prendre connaissance, d'y réfléchir et de modifier ton schéma en conséquence, le cas échéant:

En colonne Q de Test_Validation, jamais de doublons?
Idem en colonne A de Stockage? Ici, il y a un doublon (erreur ... ou pas?) Si doublons quid si dates différentes pour les occurrences d'un même identifiant? Laisse-moi deviner: tu vas dire: "ça n'arrivera jamais!"
En feuille stockage, colonne B, les dates sont toujours identiques ... mais dans la réalité, elles ne le seront pas!? Dans tous les cas ce sera toujours le premier jour du mois qui est renseigné?
En imaginant qu'on arrive à écrire, la macro ne tournera qu'une seule fois pour un mois donné?
Le nombre de lignes du fichier joint est à peu près le reflet de la réalité ... ou ça risque d'être nettement plus conséquent? Si ce devait être le cas, tu ne crains pas un plantage, à force de vouloir faire plein de choses en même temps?

Dans le shéma, il y a effectivement ton "petit oubli" à ajouter!

Pour le reste, les "branches" des L et J sont rigoureusement identiques (en dehors des instructions en jaune tout en bas)? ... on peut donc les regrouper et ne conserver une "fourche" que pour la partie en jaune?
Tu as, sur le même plan (dans les deux mêmes branches), trois cas possible: date "atteinte", date "non-atteinte" et présence de la mention "cumule" ... Ce n'est pas possible (d'autant qu'on retrouve le test du "cumule" dans la branche "date atteinte". Qu'est-ce qui est prioritaire, les dates atteintes ou non, ou alors la mention "cumule"?
Là aussi, il y a un groupe d'instructions qui sont identiques. On ne peut pas les regrouper?
Quand tu dis "Pour Identifiant correspondant Colonne K, il peut avoir plusieurs ligne avec le même identifiant", puis juste après "Suppression des cellules etc." tu veux dire que pour chaque occurrence d'un même identifiant, on supprime toutes les lignes où il apparaît?

Ouh ... j'ai mal à ma tête!

Et notre ami Staple1600 il est passé où?

Staple1600 · 16 Octobre 2016

Bonsoir à tous

Modeste à dit:
Doux Jésus !!!
Ouh ... j'ai mal à ma tête!
Et notre ami Staple1600 il est passé où?

Je suis en train de sculpter une statuette à ton effigie pour louer ton abnégation et ta persévérance pour aider christine.
Et c'est pas évident car j'écoute en même temps (en lieu et place de la grande Mireille)
http://www.college-de-france.fr//audio/en-jean-jacques-hublin/2016-2017/sem-hublin-gunz-20161011.mp3
par solidarité avec ta céphalée

Quant à la question, j'essaie en vain de voir si un remaniement des données permettrait de faire quelque chose avec un TCD ?
Mais je crains que cela me mène aussi vers la migraine assurée

mapomme · 16 Octobre 2016

Bonjour Staple1600, et Modeste,

Staple1600 à dit:
(...) http://www.college-de-france.fr//audio/en-jean-jacques-hublin/2016-2017/sem-hublin-gunz-20161011.mp3

En concluson, et j'ai bien écouté, vu ce qui fait pauvrement fonction de cerveau chez moi, je dois descendre d'une vieille branche desséchée qui n'est ni la branche néandertalienne ni celle de l'homo sapiens

Staple1600 · 16 Octobre 2016

Bonsoir mapomme

T'en penses quoi de mon histoire de TCD pour la question de christine?

PS: J'ai écouté mais pas vraiment compris car le garçon parlais anglais
Du coup, j'ai embrayé sur une autre conférence par un petit gars avec un charmant accent
L'histoire démographique et adaptative de l'Homme lue par la génétique

Modeste · 16 Octobre 2016

Re-salut aux premiers,
Mes respectueux hommages à sapomme,

Moi, je vous le dis, pour des jeunes, vous avez des occupations sacrément sérieuses le dimanche afternoon. Moi j'ai lu le titre de l'exposé en français et j'ai renoncé tout de suite

Comme je risque d'être un peu occupé demain et que christine écoutait sans doute une conférence aussi, j'ai essayé de répondre à mes propres questions et de faire des hypothèses raisonnables ... mais je suis incapable de vérifier -après coup- si les résultats sont plausibles. Je ne garantis absolument rien (pas même de m'y retrouver moi-même dans 2 heures!)

L'intéressée examinera le code ci-dessous et, si elle décide de le tester, le copiera dans un module standard (dans le dernier fichier fourni)
Comme disait Jules: "Allez, on jacte à l'Est ! "

VB:

Sub Oulala()

tabloValid = Feuil1.Range("Q2:Y" & Feuil1.Cells(Rows.Count, 17).End(xlUp).Row)
Dim miniTablo()
Application.ScreenUpdating = False
For i = 1 To UBound(tabloValid)
    With Feuil2
        '** si identifiant pas présent en stockage
        If Application.CountIf(.[A:A], tabloValid(i, 1)) = 0 Then
            .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = tabloValid(i, 1)
            .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = DateSerial(Year(Date), Month(Date) + 5, 1) '+3 ou +5??
        Else
            ' trouver ligne de l'identifiant col A de Test_Validation
            ligneID = Application.Match(tabloValid(i, 1), .[A:A], 0)
            If tabloValid(i, 9) = "J" Or tabloValid(i, 9) = "L" Then
                If .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) - 1, 1) Then
                    'supprimer toutes occurrences de l'identifiant col D à I
                    For lig = .Cells(Rows.Count, 4).End(xlUp).Row To 2 Step -1
                        If .Cells(lig, 4) = tabloValid(i, 1) Then .Cells(lig, 4).Resize(1, 6).Delete Shift:=xlUp
                    Next lig
                    'supprimer toutes occurrences de l'identifiant col K à M
                    For lig = .Cells(Rows.Count, 11).End(xlUp).Row To 2 Step -1
                        If .Cells(lig, 11) = tabloValid(i, 1) Then .Cells(lig, 11).Resize(1, 3).Delete Shift:=xlUp
                    Next lig
                End If
                'traitement des lignes avec mention cumule
                If .Cells(ligneID, 3) = "cumule" Then
                    .Cells(ligneID, 3) = ""
                    .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) + 3, 1)
                End If
                ReDim miniTablo(1 To 8)
                For x = 1 To 8
                    miniTablo(x) = tabloValid(i, x)
                Next x
                If tabloValid(i, 9) = "L" Then
                    'copier en colonne AD et suivantes
                    Feuil1.Cells(Rows.Count, 30).End(xlUp).Offset(1, 0).Resize(1, 8) = miniTablo
                Else
                    'copier en colonne AN et suivantes
                    Feuil1.Cells(Rows.Count, 40).End(xlUp).Offset(1, 0).Resize(1, 8) = miniTablo
                End If
            ElseIf tabloValid(i, 9) = "K" Then
                .Cells(ligneID, 3) = "cumule"
                .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) + 3, 1)
                ReDim miniTablo(1 To 8)
                For x = 1 To 8
                    miniTablo(x) = tabloValid(i, x)
                Next x
                Feuil1.Cells(Rows.Count, 50).End(xlUp).Offset(1, 0).Resize(1, 8) = miniTablo
            End If
        End If
    End With
Next i
Application.ScreenUpdating = True
End Sub

mapomme · 16 Octobre 2016

Bonsoir Staple1600

,

Staple1600 à dit:
T'en penses quoi de mon histoire de TCD pour la question de christine? (...)

Je ne fais que des TCD basiques. Et pour l'instant, je suis assez circonspect sur le cas "Christine". Je pense qu'en l'état des choses, le faire par VBA présenterait une possibilité d'adaptation relativement souple surtout en phase d'essai de compréhension de ce qu'il faut faire ou d'éventuelle évolution future. N'étant pas encore guéri de mon rhume et de ma toux, je ne travaillerai pas pour l'instant à ce cas. Je ne veux rien faire qui puisse entretenir mes maux de tête.

Modeste a bien du courage...

christine854 · 17 Octobre 2016

Bon bin pour le moment rien a dire c'est parfait ça a l'air de fonctionner nickel j'ai pas encore verif toutes mes données
mais en tout cas un très très grand merci a toi modeste pour le temps que tu as accordé a mon problème qui n'étais pas facile a comprendre

christine854 · 22 Octobre 2016

Bonjour Modeste
J'ai fait les test sur mon fichier et j'aurais si ça ne te dérange pas juste 2 ou 3 modification a faire.
Pour la copie en AD ou AN et AX 'il possible de copier en ajoutant la condition de date
Pour la condition K et il possible d'ajouter une condition (si K et si date ok alors mention "cumule"
de même pour le 'traitement des lignes avec mention cumule

j'ai mis en commentaire là j'aimerai ajouter la condition date

Code:

Sub Oulala()

tabloValid = Feuil1.Range("Q2:Y" & Feuil1.Cells(Rows.Count, 17).End(xlUp).Row)
Dim miniTablo()
Application.ScreenUpdating = False
For i = 1 To UBound(tabloValid)
    With Feuil2
        '** si identifiant pas présent en stockage
       If Application.CountIf(.[A:A], tabloValid(i, 1)) = 0 Then
            .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) = tabloValid(i, 1)
            .Cells(Rows.Count, 1).End(xlUp).Offset(0, 1) = DateSerial(Year(Date), Month(Date) + 3, 1)
       Else
            ' trouver ligne de l'identifiant col A de Test_Validation
           ligneID = Application.Match(tabloValid(i, 1), .[A:A], 0)
            If tabloValid(i, 9) = "J" Or tabloValid(i, 9) = "L" Then
                If .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) - 1, 1) Then
                    'supprimer toutes occurrences de l'identifiant col D à I
                   For lig = .Cells(Rows.Count, 4).End(xlUp).Row To 2 Step -1
                        If .Cells(lig, 4) = tabloValid(i, 1) Then .Cells(lig, 4).Resize(1, 6).Delete Shift:=xlUp
                    Next lig
                    'supprimer toutes occurrences de l'identifiant col K à M
                   For lig = .Cells(Rows.Count, 11).End(xlUp).Row To 2 Step -1
                        If .Cells(lig, 11) = tabloValid(i, 1) Then .Cells(lig, 11).Resize(1, 3).Delete Shift:=xlUp
                    Next lig
                End If
                'traitement des lignes avec mention cumule
               If .Cells(ligneID, 3) = "cumule" Then 'ajout condition date "Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date)  - 1, 1)"
                    .Cells(ligneID, 3) = ""
                    .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) + 3, 1)
                End If
                ReDim miniTablo(1 To 8)
                For x = 1 To 8
                    miniTablo(x) = tabloValid(i, x)
                Next x
                If tabloValid(i, 9) = "L" Then 'ajout condition date "Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date)  - 1, 1)"
                    'copier en colonne AD et suivantes
                   Feuil1.Cells(Rows.Count, 30).End(xlUp).Offset(1, 0).Resize(1, 8) = miniTablo
                Else
                    'copier en colonne AN et suivantes
                   Feuil1.Cells(Rows.Count, 40).End(xlUp).Offset(1, 0).Resize(1, 8) = miniTablo
                End If
            ElseIf tabloValid(i, 9) = "K" Then 'ajout condition date "Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date)  - 1, 1)"
                .Cells(ligneID, 3) = "cumule"
                .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) + 3, 1)
                ReDim miniTablo(1 To 8)
                For x = 1 To 8
                    miniTablo(x) = tabloValid(i, x)
                Next x
                Feuil1.Cells(Rows.Count, 50).End(xlUp).Offset(1, 0).Resize(1, 8) = miniTablo
            End If
        End If
    End With
Next i
Application.ScreenUpdating = True
End Sub

Modeste · 22 Octobre 2016

Bonsoir,

Ma première question est: "si tu sais comment écrire la condition et que tu sais où l'insérer ... pourquoi ne pas le faire toi-même? "
Ou alors tu l'as fait et les résultats ne sont pas ceux attendus? Dans ce cas, jette un œil à la pièce jointe: j'avais essayé de "réduire" ton schéma. Dis-nous ce qui est correct et ce qu'il faut modifier (parce que tes dernières consignes sont à nouveau un peu obscures

)

christine854 · 22 Octobre 2016

oui j'ai essayée d'ajouter les conditions mais sans résultat
en faite faudrait juste ajouter la condition de date de la colonne B là ou j'ai mis en commentaire
tu la test en début de macro mais pas pour les copier If .Cells(ligneID, 2) = DateSerial(Year(Date), Month(Date) - 1, 1)
je modifie le schéma et je te le reposte

adapter macro

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Junior

Pièces jointes

XLDnaute Junior

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Junior

XLDnaute Junior

XLDnaute Barbatruc

Pièces jointes

XLDnaute Junior

Discussions similaires

Partager cette page

Statistiques des forums