Récuperer valeur entête colonne sous condition

fbrcrsi

XLDnaute Nouveau
Bonjour.
J'ai une feuille excel pour un planning de visite, feuille "Planning" dans l'exemple joint.
Par ligne, j'ai donc le nom du client, et a chaque fois qu'il est visité, je met 1 dans la colonne correspondant a la date de visite qui est l'en-tête de la colonne.
Ce que j'aimerais faire, c'est dans une seconde feuille nommée "Sortie" dans l'exemple joint, récuperer l'en-tête de colonne (donc la date de visite) si la valeur de la colonne est a 1 et en faire un tableau synthèse compacte comme dans la feuille "Sortie"

J'espère avoir été complet dans ma demande.

Merci
 

Pièces jointes

  • feuille-exemple.xlsx
    52.7 KB · Affichages: 13

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour le fil, bonjour le forum,

Très en retard, tant pis, je propose quand même :

VB:
Sub Macro1()
Dim P As Worksheet 'déclare la variable P (onglet Planning)
Dim S As Worksheet 'déclare la variable S (onglet Sortie)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim TD() As Variant 'déclare la variable TD (Tableau des Dates)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)

Set P = Worksheets("Planning") 'définit l'onglet P
Set S = Worksheets("Sortie") 'définit l'onglet S
TV = P.Range("A3").CurrentRegion 'définit le tableau des valeurs TV (actuellement la plage A1:HI8)
For I = 4 To UBound(TV, 1) - 1 'boucle 1 :  sur toutes les lignes I du tableau des valeurs (en partant de la ligne 4 jusqu'à l'avant dernière)
  K = 0: Erase TD 'initialise la variable K, vide le tableau TL
  ReDim Preserve TD(K) 'redimensionne le tableau TL
  TD(K) = TV(I, 3) 'récupère le nom dans la ligne K de TL
  K = K + 1 'incrémente K
  For J = 6 To UBound(TV, 2) 'boucle 2 : sur toutes les colonnes du tableau des valeurs TV (en partant de la colonne 6)
  If TV(I, J) = 1 Then 'condition : si la valeur de la donnée ligne I colonne J du tableau des valeur TV est égale à 1
  ReDim Preserve TD(K) 'redimensionne le tableau TL
  TD(K) = DateSerial(Year(Date), Split(TV(3, J), "/", , vbTextCompare)(1), Split(TV(3, J), "/", , vbTextCompare)(0)) 'récupère la date dans la ligne K de TL
  K = K + 1 'incrémente K
  End If 'fin de la condition
  Next J 'prochaine colonne de la boucle
  S.Cells(I, "B").Resize(1, UBound(TD)).Value = TD 'renvoie dans la cellule ligne I colonne B redimensionnée de l'onglet S, le tableau des dates TD
Next I 'prochaine ligne de la boucle
End Sub
 

fbrcrsi

XLDnaute Nouveau
Très en retard, tant pis, je propose quand même :
Votre solution, ainsi que les deux autres, fonctionne parfaitement.
Un très grand merci a vous trois, et bravo pour la rapidité de réponse.
@mapomme je n'avais pas imaginer utiliser cette feuille sur plusieurs années, c'est pourquoi l'année n'est pas indiquée.
En revanche, le problème posé par
les dernières dates colonnes HG à HJ sont du n'importe quoi
est directement induit par le manque de l'année. C'est pourquoi je vais imaginer utiliser l'année.

Merci en tout cas pour vos réponse rapides et précises :)
 

Discussions similaires

Réponses
0
Affichages
141
Réponses
17
Affichages
403