récupérer et séparer les données d'une cellule

[Bolschack]

Bonjour a tous,
Je dispose d'une base de donnée bien plus conséquente que dans l'exemple ci-joint mais le principe reste le même:
je voudrais faire une macro vba qui, d’après la base de la feuille1, créer ou mettre a jour le tableau de la feuille2.
Pour remplir le tableau chaque colonne correspond à différentes partie de la colonne "bloc note" qui est exporté d'un logiciel, je peux structurer le bloc note comme je le souhaite j'avais donc pensé regarder dans la cellule a chaque fois qu'il y a un saut de ligne ("\n" pour les intimes ) et copier la ligne mais je ne gère pas assez bien le vba pour pouvoir prétendre réussir cela. Par ailleurs, pour remplir les colonne "Enquete", "Infirmerie" et "Interv. pompier", je pensais simplement regarder si dan la cellule il y a le code qui correspond Enq+ pour "Enquete" par exemple et mettre la case verte et sinon rouge et cela pour toute les colonne "binaire".
Beaucoup de texte je pense pour un sujet qui peut-être n'est pas bien dur.
Merci de votre aide

 

[pierrejean]

Re : récupérer et séparer les données d'une cellule

Bonjour Bolschack

Vois si cela te convient

 

[Bolschack]

Re : récupérer et séparer les données d'une cellule

C'est ce que je recherche cependant est-ce possible d'avoir une macro commenté pour pouvoir l'exploiter correctement et l'adapter a ma base et si jamais il y a des fonctionnalité à modifier ou ajouter ?

 

[pierrejean]

Re : récupérer et séparer les données d'une cellule

Re

Voici , en esperant que ce soit suffisament clair

Sub extract()
'mise tableau des titres de la feuille 2
tablo = Sheets("Feuil2").Range("C1:F1")
'Effacement des resultats precedents (peut etre supprimée si plusieurs transferts successifs a effectuer)
Sheets("Feuil2").Range("A2:F" & Rows.Count).ClearContents
'pour chaque cellule de la colonne C de la feuille 1 a partir de la ligne 2
For n = 2 To Range("C" & Rows.Count).End(xlUp).Row
'chercher la derniere ligne vide de la feuille2 colonne A
  derlin = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row + 1
'inscrire en colonne A et B feuille 2  les noms et prenoms
  Sheets("Feuil2").Range("A" & n) = Sheets("Feuil1").Range("A" & n)
  Sheets("Feuil2").Range("B" & n) = Sheets("Feuil1").Range("B" & n)
' Mettre sous forme de tableau le contenu de la cellule (decoupage a chaque retour chariot
x = Split(Range("C" & n), Chr(10))
' pour chaque element de ce tableau
 For m = LBound(x) To UBound(x)
 'chercher dans le tableau des titres si l'un d'eux est present
  For p = LBound(tablo, 2) To UBound(tablo, 2)
   If InStr(x(m), tablo(1, p)) <> 0 Then
   'si oui chercher ou se situe le :
     Z = InStr(x(m), ":")
     'inscrire en feuille 2 le contenu situé apres le :
     Sheets("Feuil2").Cells(derlin, p + 2) = Mid(x(m), Z + 1)
    End If
  Next
 Next
Next
'presenter la feuille 2
Sheets("Feuil2").Select
End Sub