Discussion :

[nonesofar]

Bonjour le forum,

Demande peu particulière, je souhaite améliorer une solution que j'ai développé. Tout fonctionne correctement, mais je trouve que ça fait un peu bricolage


Actuellement j'utilise des formules dans une boucle vba et cela est assez complexe à maintenir, j'aurais souhaité une solution en vba pur. Mais je sais pas trop comment prendre le problème.


Le planning:



Les formules utilisées dans une boucle.




Voila un extrait du résultat attendu.



J'ai pensé à copier coller les valeurs dans la table résultat dans une boucle. Mais cela est beaucoup trop lent.

En effet, il faudrait pas ralentir la solution actuellement en place

Merci d'avance pour vos avis.

[BENNASR]

Bonjour
essayer avec ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Sub Extrairedonnées()
 
Dim i As Long
 
Dim j As Integer
With Sheets("feuil1") ' à adapter
i = .Range("A" & Rows.Count).End(xlUp).Row
 
j = 2
For C = 4 To 13
For i = 2 To i
             If .Cells(i, C) <> "" Then
                Sheets("feuil2").Cells(j, 1) = .Cells(i, 1)
                Sheets("feuil2").Cells(j, 2) = .Cells(1, C)
                Sheets("feuil2").Cells(j, 5) = .Cells(i, C)
             j = j + 1
             End If
  Next i
  Next C
End With
End Sub

[nonesofar]

Bonjour,

Merci pour votre retour, mais je viens de tester sur mon exemple.

Cela n'affiche pas résultat un concluant. En effet j'ai eu le même problème, je ne vois pas comment boucler sans reprendre les entêtes à chaque fois.

[BENNASR]

Bonsoir
merci de vérifier je crois que c'est un problème d'adaptation à ton fichier
au premier code j'ai ajouter q chose pour te permettre de scinder la chaîne de caractère en deux : journée et période et voila le code complet :
NB : Je suis débutant et certain que il nécessite des amélioration

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub Extrairedonnées()
 
 'commencer par nettoyer la feuille destination
 
 Sheets("feuil2").Cells.ClearContents 'efface le contenu de la sheet2 pour y mettre le résultat
 Sheets("feuil2").Range("A1") = "code" 'nom de la colonne contenant la date
  Sheets("feuil2").Range("B1") = "journée/periode"
  Sheets("feuil2").Range("C1") = "journée"
  Sheets("feuil2").Range("D1") = "periode"
  Sheets("feuil2").Range("E1") = "identifiant"
 
 
 
Dim z As Long
Dim j As Integer
j = 2
With Sheets("feuil1") ' à adapter
z = .Range("A" & Rows.Count).End(xlUp).Row
For C = 4 To 13
For z = 2 To z
 
             If .Cells(z, C) <> "" Then
                Sheets("feuil2").Cells(j, 1) = .Cells(z, 1)
                Sheets("feuil2").Cells(j, 2) = .Cells(1, C)
                Sheets("feuil2").Cells(j, 5) = .Cells(z, C)
             j = j + 1
             End If
  Next z
  Next C
 
  End With
 
' séparer la journée
 
With Sheets("feuil2")
Dim n As Long
n = .Range("A" & Rows.Count).End(xlUp).Row
    For n = 2 To n
    Tableau = Split(.Cells(n, 2), " ")
    For i = 0 To UBound(Tableau)
        Debug.Print Tableau(i)
    Next i
    .Cells(n, 3) = Tableau(0) ' la journée
    .Cells(n, 4) = Tableau(1) ' la période
    Next n
End With
 
Sheets("feuil2").Select
End Sub

BONNE CONTINUATION

[nonesofar]

Bonsoir,

Effectivement, c'est la première ligne qui fait tout planter. Il suffit de la virer et hop ça tourne nickel.

Je viens de tester c vraiment bien, je tiens à te remercier pour ton aide.

Passé en résolu.