reprendre les dates contenues dans une liste pour les mettre dans un tablau

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

pascal21

XLDnaute Barbatruc
bonjour à tous
j'ai une liste de véhicules avec les dates de différentes operations à réalisées (controle technique, entretien, etc...) que j'ai appelé A B C D E F dans l'exemple joint pour simplifier
j'aimerais intégrer ces données sous forme de tableau (feuil1) pour avoir un visuel plus confortable
il s'agirait d'indiquer l'immat. du véhicule
soit sous forme de commentaire dans les cellules concernées (solution que je retiens en priorité) soit sous forme classique dans les cellules
voir le fichier joint
merci de votre aide
 

Pièces jointes

Re : reprendre les dates contenues dans une liste pour les mettre dans un tablau

Bonjour pascal21,

Voir le fichier joint avec cette macro :

Code:
Sub Immatriculations()
Dim plage1 As Range, plage2 As Range, rc&, i&, j As Byte, k&, im$
Set plage1 = Feuil1.Range("B5:G" & Feuil1.[A65536].End(xlUp).Row)
Set plage2 = Feuil2.Range("F5:K" & Feuil2.[E65536].End(xlUp).Row)
rc = plage2.Rows.Count
Application.ScreenUpdating = False
plage1.ClearContents 'RAZ
For i = 1 To plage1.Rows.Count
  For j = 1 To 6
    im = ""
    For k = 1 To rc
      If plage1(i, 0) <> "" And _
        plage1(i, 0) = plage2(k, j) Then _
          im = im & vbLf & plage2(k, 0)
    Next
    If im <> "" Then plage1(i, j) = Mid(im, 2)
  Next
Next
plage1.WrapText = True 'renvoi à la ligne
plage1.Rows.AutoFit 'ajustement automatique
End Sub
Edit : avec If im <> "" Then c'est plus rapide.

A+
 

Pièces jointes

Dernière édition:
Re : reprendre les dates contenues dans une liste pour les mettre dans un tablau

Re,

S'il y a un très grand nombre de lignes il vaut mieux utiliser cette macro :

Code:
Sub Immatriculations()
Dim col1, col2, ub&, tablo1, tablo2, i&, d, j As Byte, im$, k&
col1 = Feuil1.Range("A5", Feuil1.[A65536].End(xlUp))
col2 = Feuil2.Range("E5", Feuil2.[E65536].End(xlUp))
ub = UBound(col2)
ReDim tablo1(1 To UBound(col1), 1 To 6)
tablo2 = Feuil2.[F5].Resize(ub, 6)
For i = 1 To UBound(col1)
  d = col1(i, 1)
  For j = 1 To 6 
    im = ""
    For k = 1 To ub
      If d <> "" And d = tablo2(k, j) Then _
        im = im & vbLf & col2(k, 1)
    Next
    If im <> "" Then tablo1(i, j) = Mid(im, 2)
  Next
Next
With Feuil1.[B5].Resize(UBound(tablo1), 6)
  .Value = tablo1
  .WrapText = True 'renvoi à la ligne
  .Rows.AutoFit 'ajustement automatique
End With
End Sub
Elle est plus rapide car elle utilise 4 tableaux VBA.

Fichier (2).

A+
 

Pièces jointes

Dernière édition:
Re : reprendre les dates contenues dans une liste pour les mettre dans un tablau

Bonjour Pascal,

Si l'on veut mettre les immatriculations dans des commentaires :

Code:
Sub Immatriculations()
Dim plage1 As Range, plage2 As Range, rc&, i&, d, j As Byte, im$, k&
Set plage1 = Feuil1.Range("B5:G" & Feuil1.[A65536].End(xlUp).Row)
Set plage2 = Feuil2.Range("F5:K" & Feuil2.[E65536].End(xlUp).Row)
rc = plage2.Rows.Count
Application.ScreenUpdating = False
plage1.ClearComments 'RAZ
For i = 1 To plage1.Rows.Count
  d = plage1(i, 0)
  For j = 1 To 6
    im = ""
    For k = 1 To rc
      If d <> "" And d = plage2(k, j) Then _
        im = im & vbLf & plage2(k, 0)
    Next
    If im <> "" Then
      With plage1(i, j).AddComment
        .Text Mid(im, 2)
        .Shape.TextFrame.AutoSize = True
        .Visible = False
      End With
    End If
  Next
Next
End Sub
Fichier (3).

A+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour