XL 2019 Macro : Placement d'un texte dans un tableau : VBA impératif

limagerit

XLDnaute Occasionnel
Bonjour à tous,

Je cherche un bout de code pour placer un texte long ( en moyenne 50 caractères) dans un tableau selon une condition de date .
L'approche par macro est nécessaire car l'utilisation de formule coupe mon texte.
En effet le texte et long et les cases du calendrier seront petites .

N'ayant aucune connaissance en macro, je ne sais pas par quel bout le prendre.

Ci joint un exemple du fichier fini souhaité.

Merci de votre aide ou de vos précieux conseils.
 

Pièces jointes

  • macro placement.xlsx
    10.5 KB · Affichages: 7

Dranreb

XLDnaute Barbatruc
Bonjour.
Dans un nouveau module :
VB:
Option Explicit

Sub Placement()
   Dim Date0 As Date, TDon(), L&, C&, TRés(-1 To 48, 1 To 50)
   Date0 = Feuil1.[C5].Value - 1
   TDon = Feuil1.[A8].Resize(Feuil1.[A1000000].End(xlUp).Row - 7, 2).Value
   For L = 1 To UBound(TDon)
      C = TDon(L, 2) - Date0: TRés(L, C) = TDon(L, 1): TRés(-1, C) = TDon(L, 1)
      Next L
   Feuil1.[C6].Resize(50, 50).Value = TRés
   End Sub
 

Dranreb

XLDnaute Barbatruc
Ajoutez une instruction On Error Resume Next au début si vous voulez juste empêcher que l'erreur provoque l'arrêt de l'exécution. Si ça ne change rien, vérifier si les options VBA ne prévoient pas un arrêt sur toutes les erreurs, même pourtant gérées.
 

limagerit

XLDnaute Occasionnel
DranRed ; Patrick , Merci bien c'est absolument magnifique .

Puis je me permettre de complexifier le tableau :

Jusqu'à présent, j'ai une zone jaune de data et un résumé
Je souhaite empiler plusieurs zones jaune et plusieurs résumés ( 15 zones au total) .
cf le fichier fait pour le moment avec 3 zones

Avec possibilité de rajout de ligne dans chaque zone
et le contenus de la zone Jaune , se résumant dans chaque ligne verte intermédiaire.

Cela vous semble jouable ?
Promis je n'ajoute plus rien après.
 

Pièces jointes

  • macro placement V2.xlsm
    21.2 KB · Affichages: 2

Dranreb

XLDnaute Barbatruc
Alors essayez comme ça :
VB:
Option Explicit

Sub Placement()
   Dim RngDon As Range, Date0 As Date, TDon(), L&, LRésum&, C&, TRés()
   Set RngDon = Feuil1.UsedRange
   TDon = RngDon(2, 1).Resize(RngDon.Rows.Count - 1, 2).Value
   ReDim TRés(1 To UBound(TDon, 1), 1 To RngDon.Columns.Count - 2)
   Date0 = RngDon(1, 3).Value - 1
   For L = 1 To UBound(TDon, 1)
      If IsDate(TDon(L, 2)) Then
         C = TDon(L, 2) - Date0: TRés(L, C) = TDon(L, 1): TRés(LRésum, C) = TDon(L, 1)
      ElseIf Left$(TDon(L, 2), 6) = "Résumé" Then
         LRésum = L: End If
      Next L
   RngDon(2, 3).Resize(UBound(TRés, 1), UBound(TRés, 2)).Value = TRés
   End Sub
 

patricktoulon

XLDnaute Barbatruc
re
avec ma version
tu fait simplement un find previous sur "b" a partir de la ligne lig et tu prend le row et tu a ta ligne d’entête Résum a chaque fois
et je compile les doublons case du 27/02/2022
 

Pièces jointes

  • macro placement V3 patricktoulon.xlsm
    23.4 KB · Affichages: 1

limagerit

XLDnaute Occasionnel
Wahouuu , C'est bluffant . Tout les deux vous êtes magique
Tous les tests sont passés sans aucun souci ,
Je ne sais pas comment vous faites pour que cela vous parait logique ,

Puis je encore abuser ? oui je sais j'avais promis de ne rien ajouter ,

J'ai un petit code qui me permet d'ajouter une ligne en auto dans une feuille et je voudrais l'adapter pour le déclencher via un petit bouton + sur chaque secteur.
dans mon fichier ajout il est sur la feuille et je le voudrais dans un module mais dans ce cas j'ai le debuger qui s'ouvre.
Comment puis je changer cela svp ?


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> Range("A65536").End(xlUp).Address Then Exit Sub
If Target = "" Then Exit Sub
Dim T
Application.ScreenUpdating = False
Application.EnableEvents = False ' pour ne pas se mordre la queue
T = Target.Value 'mémorise la valeur
Rows(2).Copy Target.EntireRow.Resize(2) 'copie la ligne 2 et colle sur 2 lignes
Union(Target.Resize(, 7), Target.Offset(1).EntireRow).ClearContents
Target = T
Application.EnableEvents = True
End Sub


Merci de votre aide
 

Pièces jointes

  • ajout ligne auto.xlsm
    16 KB · Affichages: 0
  • macro placement dranreb.xlsm
    21.3 KB · Affichages: 0
  • macro placement V3 patricktoulon.xlsm
    23.7 KB · Affichages: 0

Discussions similaires