VBA - Collage spécial valeur sur une même cellule

Fermé
Vampeatsnake Messages postés 27 Date d'inscription lundi 27 février 2012 Statut Membre Dernière intervention 17 juillet 2013 - 7 juil. 2013 à 21:11
 foo - 17 juil. 2013 à 18:44
Bonjour,

Suite à ce sujet: https://forums.commentcamarche.net/forum/affich-28127438-figer-une-cellule-en-fonction-d-une-autre#p28127661 , je n'ai pas trouvé de solution, ou du moins étant complètement novice en VBA, je me trouve dans une impasse.

Le fichier n'est plus d'actualité, mais ma problématique reste semblable.

Pour résumer, je souhaite que certaines cellules contenant des formules soient écrasées et ne contiennent plus que leur valeur si la date est antérieure à la date actuelle. Difficile à expliquer mais le fichier en question devrait clarifier tout ça:
https://www.cjoint.com/?0GhvkeAqNdt


Merci.
A voir également:

10 réponses

f894009 Messages postés 17217 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 27 décembre 2024 1 712
8 juil. 2013 à 09:26
Bonjour,

code a mettre dans un module, ensuite voir comment le lancer:
_ a l'ouverture du fichier pour un tour

_ module tourne toute les x minutes

a vous de voir

Sub fige_taux()
    Dim mois, lig, col, compt
    
    Application.ScreenUpdating = False
    
    'mois courant
    mois = Month(Now())
    With Worksheets("feuil1")
        'derniere cellule non vide colonne A
        derlig = .Range("A" & Rows.Count).End(xlUp).Row
        'init compteur mois
        compt = 1
        'boucle ligne pas de 3
        For lig = 4 To derlig Step 3
            'test cellule Ax non vide
            If .Cells(lig, 1) <> "" Then
                'boucle colonne pas de 2
                For col = 6 To 28 Step 2
                    'test mois-1
                    If compt < 3 Then
                        'reecriture cellule
                        .Cells(lig, col) = .Cells(lig, col).Value
                    Else
                        'sortie boucle colonne
                        Exit For
                    End If
                    'increment compteur mois
                    compt = compt + 1
                Next col
                'init compteur mois
                compt = 1
            End If
        Next lig
    End With

    Application.ScreenUpdating = True
    
End Sub


'a lancer en cas de plantage pour rafraichissement feuille
Sub test()
    Application.ScreenUpdating = True
End Sub


A+
0
Vampeatsnake Messages postés 27 Date d'inscription lundi 27 février 2012 Statut Membre Dernière intervention 17 juillet 2013 7
Modifié par Vampeatsnake le 8/07/2013 à 10:34
Bonjour f894009,

J'ai essayé votre code qui correspond à ce que je souhaite faire et je vous remercie. Cependant, il ne prend en compte que les colonnes F et H. Comment faire pour l'étendre jusqu'à AB?

Aussi le fichier final comprendra plusieurs tableaux construits sur le même modèle que ce dernier et je souhaiterais que le code s'applique pour ces tableaux également. Faut-il créer une boucle, un nouveau module? (il y aurait une ligne d'espace entre chaque tableau)

Merci pour votre aide.

Cordialement

PS: pour le lancement je pense qu'il se fera à l'ouverture du fichier.

Edit: en fait les mois ne sont pas au format date à partir de mars (c'est un oubli de ma part), mais même en les mettant au format date, ils ne sont pas pris en compte.
0
f894009 Messages postés 17217 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 27 décembre 2024 1 712
8 juil. 2013 à 11:10
Re,

If compt < 3 Then------> remplacez 3 par mois-1 (j'avais mis 3 pour les tests)

Edit: en fait les mois ne sont pas d'importance, j'utilise le format de fichier pas le contenu des cellules

Aussi le fichier final comprendra plusieurs tableaux le meme module doit etre suffisant, c'est une logique de programmation. Vos tableaux seront de hauteurs variables ou fixes ?????
0
Vampeatsnake Messages postés 27 Date d'inscription lundi 27 février 2012 Statut Membre Dernière intervention 17 juillet 2013 7
8 juil. 2013 à 11:17
Merci,
La logique VBA n'est pas encore tout à fait évidente pour moi mais ça viendra...
J'ai fait la modification, cela fonctionne.

En ce qui concerne les autres tableaux ils sont identiques (8 lignes,32 colonnes), ils sont espacés d'une ligne et sont bien pris en compte.

Cependant, certains ont un espace de deux lignes et ils ne sont plus pris en compte par le code.
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
f894009 Messages postés 17217 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 27 décembre 2024 1 712
8 juil. 2013 à 11:28
Re,

Il faut faire des tableaux de donnees pour avoir les infos par tableaux: ligne de depart, ligne de fin, pas des lignes a ecrire
de facon a ne pas tester si la cellule Ax est vide, ce qui actuellement fait sortir du code d'ecriture cellule

A+
0
Vampeatsnake Messages postés 27 Date d'inscription lundi 27 février 2012 Statut Membre Dernière intervention 17 juillet 2013 7
8 juil. 2013 à 12:57
Merci à vous je vais essayer d'écrire le code.
0
Vampeatsnake Messages postés 27 Date d'inscription lundi 27 février 2012 Statut Membre Dernière intervention 17 juillet 2013 7
17 juil. 2013 à 16:10
Bonjour f894009,

Je ne vois pas trop comment construire le code pour les tableaux. Pouvez-vous me donner un exemple?

Merci.
0
f894009 Messages postés 17217 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 27 décembre 2024 1 712
17 juil. 2013 à 17:10
Bonjour,

J'ai relu vos messages pour raccrocher au sujet, je vous modifie votre fichier.

A+
0
f894009 Messages postés 17217 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 27 décembre 2024 1 712
17 juil. 2013 à 17:30
Re,

Votre fichier de depart modifie:

https://www.cjoint.com/c/CGrrDNNb8i6

A adapter sur votre fichier de travail

A+
0
Bonjour

Voila une macro a tester bien sur
avec calcul de nombre de tableaux


Sub testMois()
VarMois = Val(Format(Now, "m"))
NumC = (VarMois * 2) + 3
With Feuil1
Coul = .Range("F4").Interior.ColorIndex
For L = 4 To .Range("K" & Rows.Count).End(xlUp).Row
If .Range("F" & L).Interior.ColorIndex = Coul Then
'Debug.Print L
Range(Cells(L, 6), Cells(L, NumC)).Copy
Range("F" & L).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End If
Next
End With
End Sub

A+

Maurice
0