Sélection de cellule en fonction du numéro de semaine

Le 31/03/2014 à 21:26

Bonsoir tous le monde ,

Je dois développer une macro pour le travail et n'ayant jamais fait ce genre de chose je suis un peu comme une poule qui aurait trouvé un couteau comme on me dit chez moi (imaginez ce que ça peu donner... ).

Alors pour l'instant j'ai bien avancé mais je bloque sur un truque et même en lissant les questions réponses postés sur le forum je n'arrive pas à trouver de solution malgré plusieurs jours de recherche.

Voici sur quoi je coince :

J'ai un tableau comportant 11 colonnes et 275 lignes. Dans la colonne I figurent un numéro de semaine.

(je suis desolée je ne peux pas partager mon fichier excel puisqu'il s'agit de données confidentiels issues de mon boulot).

Je dois sélectionner à travers de ma macro toutes les lignes et colonnes pour lesquels la semaine en cours apparaît dans la cellule I.

Quelqu'un pourrait il venir à on secours.

D'avance merci beaucoup pour votre aide

Le 31/03/2014 à 23:07

Bonsoir,

Sub selSemEnCours()
    Dim sem As Long, c As Range, plag As Range
    sem = IsoWeekNumber(Date)
    For Each c In [I2:I276]
        If c = sem Then
            If plag Is Nothing Then
                Set plag = Rows(c.Row)
            Else
                Set plag = Union(plag, Rows(c.Row))
            End If
        End If
    Next c
    Intersect(plag, [A:K]).Select
End Sub

Public Function IsoWeekNumber(ByVal d As Date) As Long
    Dim wd As Long
    wd = Weekday(d, vbMonday)
    IsoWeekNumber = Int((d - DateSerial(Year(d - wd + 4), 1, 1) - wd + 11) / 7)
End Function

La fonction doit être dans un module standard.

eric

Le 01/04/2014 à 20:41

Bonsoir Eriiic et merci pour votre réponse,

Je viens de tester la macro et il me surligne, lors du test, l'éléments que j'ai fait apparaitre en rouge ci dessous. Savez vous pourquoi?

Concernant les éléments que j'ai fais apparaitre en bleu je les ai inscrit dans un second module. J'espère avoir bien fait.

Je vous ai copié toute ma macro afin que vous puissiez voir ce que ca donne.

Merci pour votre aide

Esmee1

Sub Macro1()
'Rennommer la première feuille
'
    Worksheets(1).Name = "Extraction Wave"

' Inserer nouvelle feuille et la renommer
'
    Sheets.Add
    Worksheets(1).Name = "Audit S0"

'Selection de données semaine en cours 
'
    Dim sem As Long, c As Range, plag As Range
    sem = IsoWeekNumber(Date)
    For Each c In [I:I]
    If c = sem Then
    If plag Is Nothing Then
    Set plag = Rows(c.Row)
    Else
    Set plag = Union(plag, Rows(c.Row))
    End If
    End If
    Next c
    Intersect(plag, [A:X]).Select

Public Function IsoWeekNumber(ByVal d As Date) As Long
Dim wd As Long
wd = Weekday(d, vbMonday)
IsoWeekNumber = Int((d - DateSerial(Year(d - wd + 4), 1, 1) - wd + 11) / 7)
End Function

'supprimer les colonnes inutiles
'
    Sheets("Audit S0").Select
    Range("A:B,D:G,I:L,S:U").Select
    Selection.Delete Shift:=xlToLeft

'Remplacement des valeurs de la colonne A
'
    Sheets("Audit S0").Select
    Columns("A:A").Select
    Selection.Replace What:="01", Replacement:="Guenard K", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="02", Replacement:="Aubertin S", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="03", Replacement:="Amourette N", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="04", Replacement:="Gemetto Ca", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="07", Replacement:="Varinot A", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="08", Replacement:="Deminuid N", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="09", Replacement:="Mercier V", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="11", Replacement:="Hichard A", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="12", Replacement:="Lenoir C", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="13", Replacement:="Simon T", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="16", Replacement:="Singler R", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="17", Replacement:="Bonnefoy A", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="21", Replacement:="Loisy P", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="24", Replacement:="Prieur C", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="32", Replacement:="Mélanie", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="34", Replacement:="Husson D", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="36", Replacement:="Fatihi S", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="38", Replacement:="Varinot B", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="49", Replacement:="Bouche F", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="55", Replacement:="Toussaint C", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="60", Replacement:="Jeandot E", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="65", Replacement:="Moreau R", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="66", Replacement:="Bergami F", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="67", Replacement:="Schillinger F", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="81", Replacement:="Aubry G", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="100", Replacement:="Interim", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="AN", Replacement:="Amourette N", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="BA", Replacement:="Bonnefoy A", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="BF", Replacement:="Briaux F", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="BP", Replacement:="Blot P", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="DM", Replacement:="Destainville M", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="DS", Replacement:="Douge S", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="EI", Replacement:="Estevez I", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="FC", Replacement:="Firion C", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="FS", Replacement:="Fatihi S", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="HD", Replacement:="Husson D", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="JNF", Replacement:="François JN", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="GC", Replacement:="Gimondo C", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="LP", Replacement:="Loisy P", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="MV", Replacement:="Mercier V", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="PP", Replacement:="Prieur P", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="RC", Replacement:="Raffat C", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="TN", Replacement:="Tagnon N", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="US", Replacement:="Usun S", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="VJ", Replacement:="Vitter J", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True

'Remplacement des valeurs de la colonne B
'
    Sheets("Audit S0").Select
    Columns("B:B").Select
    Selection.Replace What:="Plastic 1.5", Replacement:="Orma", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="Polycarbonate (PC)", Replacement:="Airwear", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="Plastic 1.67", Replacement:="Stylis", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="Plastic 1.6", Replacement:="Ormix", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="Plastic 1.56", Replacement:="Ormix", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True

'Remplacement des valeurs de la colonne D
'
    Sheets("Audit S0").Select
    Columns("D:D").Select
    Selection.Replace What:="000 : Commercial", Replacement:="000", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="003 : Coated Lens", Replacement:="003", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True

'Remplacement des valeurs de la colonne E
'

    Sheets("Audit S0").Select
    Columns("E:E").Select
    Selection.Replace What:="021 : Not Justified", Replacement:="021", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="311 : Spot Defect", Replacement:="311 : Manipulation", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="332 : Speaded Defect", Replacement:="332 : Coulure >3mm", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="329 : Miscellaneous", Replacement:="329 : Appairage teinte", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="342 : Speaded Defect", Replacement:="342 : Empreinte / Poussière / Tache", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="312 : Speaded Defect", Replacement:="312 : Voile", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="314 : Internal Defect", Replacement:="314 : Defaut Fini ou SF brut", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="319 : Other Defect", Replacement:="314 : Anneau / Point au centre", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="352 : Cosmetic", Replacement:="352 : Aspect signature / Gravure", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="343 : AR Coating Reliability", Replacement:="343 : Craquelure", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
    Selection.Replace What:="331 : Spot Defect", Replacement:="331 : Cratère", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=True
End Sub

Le 01/04/2014 à 21:52

Bonsoir,

je ne vois pas de rouge.

eric

Le 01/04/2014 à 22:22

Bonsoir,

Oups voici ce qui aurait du apparaitre en rouge

Intersect(plag, [A:X]).Select

Esmee1

Le 01/04/2014 à 23:05

Peut-être dû à 2007 (?) mais je ne vois pas trop ce qui le dérange.

Au cas ou remplace par :

Intersect(plag, range("A:X")).Select

Sinon met ton fichier que je vois si je constate l'erreur.

eric

Le 02/04/2014 à 15:29

Bonjour Eric,

Ça ne fonctionne pas non plus.

Voici mon fichier j'ai juste supprimé quelques lignes et colonnes pour des soucis de confidentialité. J'ai modifié la macro en conséquence.

Merci pour ton aide

32macro-audit.zip (59.12 Ko)

Le 02/04/2014 à 16:14

Bonjour,

1) met le curseur dans ta macro et exécute-là en pas à pas avec F8 en gardant un oeil sur ton classeur, tu comprendras tout de suite.

2) de plus tu demandes pour une semaine en colonne I, elle est ailleurs et tu n'adaptes pas le code. Ca ne risque pas de fonctionner. Il faut un minimum de cohérence.

3) tu as demandé une sélection de lignes... pour ne rien en faire (?!??:!) La ligne suivante est un autre .select

4) par ailleurs faire 50 lignes de code pour remplacer 50 chaines par une autre n'est d'aucune efficacité. Personne ne procède ainsi.

Le jour où tu as un nouveau nom tu vas aller modifier ton programme ?

Il faut que tu crées des tables de conversions sur une autre feuille, qui seront faciles à mettre à jour. Et ton code doit aller lire ces tables avec des boucles pour traduire.

Ne le prend pas mal mais je crois que tu as strappé la phase apprentissage, commence par là.

Tu ne trouveras pas grand monde pour te tenir la main plusieurs jours pour acquérir le B.A.BA. Il faut le faire toi même par des recherche sur google. Tu peux commencer sur ce site en lisant tous les 'COURS VBA' (menu en haut)

eric

Le 02/04/2014 à 22:46

Bonsoir Eric,

Malheureusement pour moi j'ai du mal à comprendre les cours présent sur les différents site dédiés à la création de macro via VBA alors j'essaie de me débrouiller comme je peux (en copiant par exemple plusieurs fois une formule donner sur un site permettant de remplacer des valeurs par des autres).

Je pense effectivement que ce genre de chose peut paraître archaïque pour certaines personnes mais est ce que j'ai vraiment le choix?, La réponse est non.

Le fait est que je dois développer une macro sans n'avoir jamais eu aucune aide sur le sujet et en un temps record. Je suis même obligée de travaillé sur ce projet les soirs et le week end.

Alors en m'inscrivant sur ce forum j'attendais un peu d'aide.

Bonne soirée

Le 02/04/2014 à 23:59

Ok, mais à faire des copier-coller sans comprendre ton code n'a aucun sens, tu n'y arriveras jamais.

Si sur ton CV tu n'as pas écris connaissances en VBA tu pourrais demander une formation.

Décris plutôt précisément et clairement comment tu reçois les données et ce que tu dois faire.

Si c'est simplement remplacer des chaines par d'autres on pourra te le faire si tu prépares sur une autre feuille des tables de conversion et des instructions claires (pourquoi une autre feuille ? Quoi y coller ? Dans quelle colonne utiliser telle table ? etc).

Maintenant si c'est une appli complète c'est autre chose. On aide ponctuellement sur un pb, mais on n'a pas forcément 3 jours pleins ou 3 semaines à y consacrer.

eric

Le 06/04/2014 à 14:18

Bonjour Eric,

Vous savez actuellement le monde du travail est difficile et en intérim je ne peux malheureusement pas prétendre à une formation....

Et même si je n'ai pas eu la prétention d'indiquer sur mon CV et lors de mon entretien que j'avais des connaissances en VBA, on m'a demandé de développer une macro.... Alors je fais ce qu'on m'a demandé...

J'ai quasiment fini la version provisoire c'est à dire la macro qu'il me restera à améliorer par la suite..... Je pense que vous comprenez ce que je veux dire....

Il me reste une dernière chose :"comment déplacer les cellules contenant l'élément SD présentent dans la colonne E" dans la même ligne mais dans la colonne K, sachant que la colonne K contient déjà des valeurs". Je vous explique je fais des audits sur des produits. Ces produits sont soit conforme sans défauts :"SD", soit conforme mais avec défaut "0", ou soit non conforme 3. Les résultats obtenus lors de l'enregistrement de ces données me permettent de déterminer la capabilité de notre processus de fabrication.

Le problème est que le logiciel permettant de saisir ces valeurs n'enregistre pas ces valeurs dans la même colonne je dois donc pour l'exploitation réunir dans la même colonne.

Bonne journée Eric et merci pour votre patience et votre aide

Le 06/04/2014 à 15:39

Bonjour,

sachant que la colonne K contient déjà des valeurs

Et tu en fais quoi de ces valeurs ?

Sinon le principe c'est :

cells(lig, "K")=cells(lig,"E")

eric

Le 06/04/2014 à 15:51

En fait, j'utilise ces valeurs pour établir un tableau croisé dynamique et au final un graphique

Le 06/04/2014 à 16:14

Il faudrait j'obtienne un histogramme avec le nombre de produits conformes sans défaut, le nombre de produits conformes avec défaut et le nombre de produits non conformes.

Il faut donc qu'il me déplace les cellules en rouge dans la colonne E de la feuille audit S0 dans la colonne K de la même feuille (il faut mieu que je déplace dans la colonne K plutôt que J sinon je vais avoir des problème) . Classeur excel joint.

10macro-audit-ok.zip (24.08 Ko)

Le 06/04/2014 à 16:29

A tester :

Sub compileEK()
    Dim nblig As Long, lig As Long
    Dim colE As Variant, colK As Variant
    Const SD As String = "SD"
    nblig = Cells(Rows.Count, "A").End(xlUp).Row - 1
    ' recup données
    colE = [E2].Resize(nblig)
    colK = [K2].Resize(nblig)
    For lig = 1 To nblig
        If colE(lig, 1) = SD Then colK(lig, 1) = SD
    Next lig
    ' coller
    [K2].Resize(nblig) = colK
    'supprimer E
    Columns("E").EntireColumn.Delete
End Sub

Rechercher des sujets similaires à "selection fonction numero semaine"