XL 2016 Simplifier un code vba

[link93]

Bonjour le Forum,

J'ai cette ligne de code qui fait très bien son office mais mon tableau ayant beaucoup de ligne et ne m'y connaissant que très peu en VBA j'ai répété x fois la ligne en changeant les cellules cibles ex :

Range(Range("CH7").Value).Value = Range("A7").Value
Range(Range("CH8").Value).Value = Range("A8").Value
Range(Range("CH9").Value).Value = Range("A9").Value

Deux problèmes à ça, un c'est très long lorsque je la lance et deux je ne sais jamais combien j'aurais de ligne et ne sais pas quand l'a faire arrêté. Quelqu'un aurait une solution ?

Merci.

 

[Dranreb]

Bonjour.
Il pourrait y avoir une légère amélioration en l'écrivant comme ça :

   Dim TAdrCel(), TVals(), L As Long
   TAdrCel = Range("CH7:CH8").Value
   TVals = Range("A7:A9").Value
   For L = 1 To UBound(TAdrCel, 1)
      Range(TAdrCel(L, 1)).Value = TVals(L, 1)
      Next L

Mais il y aurait sûrement une amélioration considérable possible si, plutôt que des adresses de cellules, la plage CH7:CH8 ne contenait que des numéros de ligne pour la même colonne destinataire partout

 

[patty58]

Bonjour link93

Sub trait()
nbl = Range("A65536").End(xlUp).Row
' en supposant que tu veuilles commencer à la lig:ne 7
For i = 7 To nbl
    Range("CH" & i).Value = Range("A" & i).Value
Next
End Sub

dis-moi

 

[link93]

Bonjour link93

Sub trait()
nbl = Range("A65536").End(xlUp).Row
' en supposant que tu veuilles commencer à la lig:ne 7
For i = 7 To nbl
    Range("CH" & i).Value = Range("A" & i).Value
Next
End Sub

dis-moi

Bonjour Patty,

Merci pour ton retour, j'ai essayé ton code, cela fonctionne mais ne copie pas les données en A1 dans la cellule indiqué dans la colonne CH mais directement dans la colonne CH. Une piste ? J'ai l'impression que c'est un peu plus rapide.

 

[link93]

Bonjour.
Il pourrait y avoir une légère amélioration en l'écrivant comme ça :

   Dim TAdrCel(), TVals(), L As Long
   TAdrCel = Range("CH7:CH8").Value
   TVals = Range("A7:A9").Value
   For L = 1 To UBound(TAdrCel, 1)
      Range(TAdrCel(L, 1)).Value = TVals(L, 1)
      Next L

Mais il y aurait sûrement une amélioration considérable possible si, plutôt que des adresses de cellules, la plage CH7:CH8 ne contenait que des numéros de ligne pour la même colonne destinataire partout

Bonjour Dranreb,

J'ai de la liberté sur le fichier si c'est plus simple je peux préciser le n° de colonne et de ligne dans les cases CH7 et CI7 ? Si j'ai bien compris l'idée.

 

[Dranreb]

Oui tout à fait.
Mais des numéros de lignes et de colonnes relatifs à la plage destinatrice seraient préférables à ceux dans la Feuille.

 

[link93]

Si je comprends bien, il faudrait indiquée aussi bien le n° de ligne et colonne de la cellule ou je veux prendre la donnée et aussi celle de la cellule destinatrice ? Comme dans le fichier joint ?

 

[Dranreb]

Si les deux sont indirects, oui …
Mais là on dirait que les numéros de colonnes peuvent être déduits des Date début et Date fin, non ?
Expliquez moins un peu ce que vous voulez faire. Votre classeur joint me perd complètement.

 

[link93]

Bonjour Danreb,

En effet les deux sont indirect. Mon objectif est d'écrire le contenue de la cellule A dans la première case bleu trouvée ou la 1er cellule de la même ligne. Par exemple sur la ligne 7 A7 en J7 et lorsqu'il n'y a pas de bleu dans la colonne G de la même ligne.

J'ai réussi en passant par une formule à déterminer par ligne ou inscrire le contenue de la cellule A et je voulais passer par VBA pour faire ce travaille de copier coller indirect.

 

[Dranreb]

Bonjour.
Vous dites que les deux sont indirect et dans la phrase suivante vous dite que la source ne l'est pas puisque c'est simplement l'ensemble des valeurs d'une plage verticale de la colonne A, qu'il suffit de capturer au début dans un tableau dynamique d'entrée.
Non, à partir du moment où il faut aller chercher des caractéristiques de cellules autres que leur valeurs, telles qu'une couleur bleue du fond on ne peut plus rien optimiser. La préparation d'un tableau dynamique à verser d'un seul coup dans toute la plage calendrier ne peut porter que sur les valeurs. Ce qui pourrait être extrêmement rapide par exemple ce serait d'écrire la valeur en A dans toutes les colonnes allant de la date de début à la date de fin. Parce que ce numéro de colonne dans le tableau à verser dans la plage de calendrier destinatrice est une simple soustraction augmentée de 1 d'avec la date correspondant à la 1ère colonne de cette plage.

 

[Dranreb]

À chaque changement dans la colonne A ou D, par exemple, cette procédure dans le module Feuil3 (Planning) met les valeurs de la colonne A dans la colonne du planning correspondant à la date indiquée en D :

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim TVals(), TDtDéb(), TPlan(), LMax As Long, L As Long, DateRéf As Date, C As Long
   If Target.Column <> 1 And Target.Column <> 4 Then Exit Sub
   TVals = [A7].Resize([A1000000].End(xlUp).Row - 6).Value
   LMax = UBound(TVals, 1)
   TDtDéb = [D7].Resize(LMax).Value
   DateRéf = [Date].Value - 1
   ReDim TPlan(1 To 200, 1 To 75)
   For L = 1 To LMax
      C = TDtDéb(L, 1) - DateRéf
      If C >= 1 And C <= 75 Then TPlan(L, C) = TVals(L, 1)
      Next L
   [G7].Resize(200, 75).Value = TPlan
   End Sub

C'est pratiquement instantané.

 

[link93]

C'est beaucoup mieux que ce a quoi je pensais. Merci pour votre aide, ca répond parfaitement à mon besoin et en effet c'est vraiment instantané.

Je n'arrive pas à voir dans le code la partie qui permet de lui indiquer la cellule correspondant à la date en colonne D.

Merci encore pour votre précieuse aide.

 

[Dranreb]

Pour ce qui est de la colonne c'est l'instruction C = TDtDéb(L, 1) - DateRéf
La ligne c'est L
L et C sont bien entendu relatifs à la plage du planning [G7].Resize(200, 75), et non pas à la feuille.
Il devrait être possible de simplifier les mises en formes conditionnelles avec ce code :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim TDon(), TPlan(), LMax As Long, L As Long, C As Integer, DateRéf As Date, CFin As Integer
  If Target.Column <> 1 And Target.Column <> 5 And Intersect([Date], Target) Is Nothing Then Exit Sub
   TDon = [A7:E7].Resize([A1000000].End(xlUp).Row - 6).Value
   LMax = UBound(TDon, 1)
   DateRéf = [Date].Value - 1
   ReDim TPlan(1 To 200, 1 To 75)
   For L = 1 To 200: For C = 1 To 75: TPlan(L, C) = Chr$(160): Next C, L
   For L = 1 To LMax
      C = TDon(L, 4) - DateRéf
      If C >= 1 And C <= 75 Then TPlan(L, C) = TDon(L, 1)
      If IsEmpty(TDon(L, 5)) Then CFin = 75 Else CFin = TDon(L, 5) - DateRéf: If CFin > 75 Then CFin = 75
      Do While C < CFin: C = C + 1: TPlan(L, C) = Empty: Loop
      Next L
   Application.EnableEvents = False
   [G7].Resize(200, 75).Value = TPlan
   Application.EnableEvents = True
   End Sub

Dans les MFC testez =G7=CAR(160) pour les cellules non couvertes par une période,
et simplement =NON(ESTVIDE($F7)) pour la couleur des cellules couvertes.