Discussion :

[QuestVba]

Bonjour, Le Forum,

Comme d'hab, quand on ne sait pas ou que l'on ne trouve même pas le début du chemin, on se tourne vers ... pleins de têtes remplies d'idées et de solutions.

Voici mon problème: dans la première image, vous trouvez le calendrier que l'on envoie. Il y a une colonne avec les traitements et ensuite la date à laquelle ils sont effectués et leur ordre (cette dernière donnée n'est pas utile). Donc, le traitement 'Paiements' aura lieu le 03/11, le 10/11, le 17/11 et le 21/11, etc pour les autres traitements. Attention que la ligne des dates peut se copier avec les mêmes dates (exemple ligne 1 et ligne 5)



Ce n'est évidemment pas très lisible surtout que le tableau comporte 200 lignes . Donc, mon but est d'obtenir un tableau avec une seule ligne de date et chaque traitement recopié une seule fois avec un 'X' le jour où il a lieu. Un peu comme



A tout hasard, je mets le fichier en PJ. Je suis preneur de toutes vos idées et autres. A vos claviers, ...

[Nako_lito]

est ce que l'ordre (1/2/3) a une importance dans la suite de ton traitement ?
(je continue de chercher de mon côté pour ta solution)

[QuestVba]

Merci, Nako_lito, de t'intéresser au problème.

L'ordre n'a aucune importance et on peut le laisser de côté.

[Nako_lito]

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Option Explicit
 
Public Const COLONNE_LIBELLE = 1
Public Const LIGNE_EN_TETE = 1
Public gWSManageSheet As Worksheet
Public gWSMonth As Worksheet
Public blnOK    As Boolean
 
Public Function manageRange(ByVal p_range As Range) As Range
 
    Dim intLigne    As Integer
    Dim intColonne  As Integer
    Dim strNameTraitement As String
    Dim intDay As Integer
    Dim range_ As Range
 
    For intLigne = 2 To p_range.Rows.Count
        strNameTraitement = p_range.Cells(intLigne, COLONNE_LIBELLE)
        For intColonne = 2 To p_range.Columns.Count
            If p_range(intLigne, intColonne) <> vbNullString Then
                Set range_ = p_range(LIGNE_EN_TETE, intColonne)
                intDay = Left(range_.Value, 2)
                If Not copyToMonthSheet(intDay, strNameTraitement) Then
                    MsgBox "erreur lors du traitement de la plage : " & vbCrLf & CStr(p_range.Address), vbOKOnly
                    Exit Function
                End If
            End If
        Next
    Next
End Function
 
Public Function copyToMonthSheet(ByVal pDay As Integer, ByVal pTraitement As String) As Boolean
    Dim intTraitementRow As Integer
    Dim i As Integer
    intTraitementRow = 0
    copyToMonthSheet = True
    For i = 1 To lastRow(gWSMonth)
        If LCase(gWSMonth.Range("A" & i)) = LCase(pTraitement) Then
            intTraitementRow = i
            Exit For
        End If
    Next
    If intTraitementRow = 0 Then
        copyToMonthSheet = False
        Exit Function
    End If
    With gWSMonth.Cells(intTraitementRow, pDay + 1)
        .Value = "X"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Function
 
Public Function isInCollection(ByVal pCol As Collection, pStr As String) As Boolean
    Dim i As Integer
    isInCollection = False
    If pCol.Count < 1 Then Exit Function
    For i = 1 To pCol.Count
        If Trim$(pCol(i)) = Trim$(pStr) Then
            isInCollection = True
            Exit For
        End If
    Next
End Function
 
Public Sub searchInCollectionAndDestroy(ByVal pCol As Collection, pStr As String)
    Dim i As Integer
    If pCol.Count < 1 Then Exit Sub
    For i = 1 To pCol.Count
        If pCol(i) = Trim$(pStr) Then pCol.Remove (i)
        Exit For
    Next
End Sub
 
Public Sub manageSheet(ByVal pStrName As String)
    Dim sheet_ As Worksheet
    Dim blnExist As Boolean
    For Each sheet_ In ThisWorkbook.Sheets
        If sheet_.Name = pStrName Then
            blnExist = True
            If MsgBox("Feuille existante, écraser ?", vbYesNo + vbQuestion) = vbYes Then
                sheet_.Cells.Clear
                Set gWSMonth = sheet_
            Else
                blnOK = False
            End If
        End If
    Next
    If Not blnExist Then
        Set gWSMonth = ThisWorkbook.Sheets.Add(after:=ThisWorkbook.Sheets.Count)
        gWSMonth.Name = pStrName
    End If
End Sub
 
Public Sub makeHeadLine()
    Dim col_ As Collection
    Dim i As Integer
    Dim firstDay As Integer
    Dim lastDay As Integer
    Dim strMonth As String
 
    firstDay = CInt(Format(DateSerial(Year(Now), Month(Now), 1), "d"))
    lastDay = CInt(Format(DateSerial(Year(Now), Month(Now) + 1, 0), "d"))
    strMonth = Format(Now, "mmmm")
 
    Set col_ = New Collection
    Set gWSManageSheet = ThisWorkbook.Sheets("Planning")
    Call manageSheet(strMonth)
    If Not blnOK Then Exit Sub
    For i = 1 To lastRow(gWSManageSheet)
        If Not isInCollection(col_, gWSManageSheet.Range("A" & i)) Then
            col_.Add Trim$(gWSManageSheet.Range("A" & i).Text)
        End If
    Next
 
    Call searchInCollectionAndDestroy(col_, "Traitement ITINP")
 
    gWSMonth.Range("A1") = Trim$("Traitement ITINP")
    For i = firstDay To lastDay
        gWSMonth.Cells(LIGNE_EN_TETE, i + 1) = DateSerial(Year(Now), Month(Now), i)
        gWSMonth.Cells(LIGNE_EN_TETE, i + 1).NumberFormat = "dd/mm"
    Next
 
    For i = 1 To col_.Count
        gWSMonth.Range("A" & i + 1) = col_(i)
    Next
 
End Sub
 
Public Sub main()
    Dim lIntIndex1  As Integer
    Dim lIntIndex2  As Integer
    Dim i           As Integer
    Dim range_      As Range
    Dim cell1_      As Range
    Dim cell2_      As Range
 
    blnOK = True
 
    Set gWSManageSheet = ThisWorkbook.Sheets("Planning")
 
    i = 1
    lIntIndex1 = 1
    lIntIndex2 = 1
 
    Call makeHeadLine
    If Not blnOK Then Exit Sub
    For i = 2 To lastRow(gWSManageSheet) + 1
        If LCase(gWSManageSheet.Range("A" & i).Text) <> "traitement itinp" And LCase(gWSManageSheet.Range("A" & i).Text <> vbNullString) Then
            lIntIndex2 = i
        Else
            Set cell1_ = gWSManageSheet.Cells(lIntIndex1, COLONNE_LIBELLE)
            Set cell2_ = gWSManageSheet.Cells(lIntIndex2, lastColumn(gWSManageSheet, lIntIndex1))
            Set range_ = gWSManageSheet.Range(cell1_, cell2_)
            Call manageRange(range_)
            lIntIndex1 = i
            lIntIndex2 = i
        End If
    Next
End Sub
 
Public Function lastRow(ByVal pws As Worksheet) As Integer
    lastRow = pws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
End Function
 
Public Function lastColumn(ByVal pws As Worksheet, ByVal pRow As Integer) As Integer
    lastColumn = pws.Cells(pRow, 128).End(xlToLeft).Column
End Function

teste ça pour voir si ça te conviens.

[QuestVba]

Alors là, je plusse déjà

Bon, quand le lance la macro j'ai une erreur en rouge :

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
...
Public Function manageRange(ByVal p_range As Range) As Range
 
    Dim intLigne    As Integer
    Dim intColonne  As Integer
    Dim strNameTraitement As String
    Dim intDay As Integer
    Dim range_ As Range
 
    For intLigne = 2 To p_range.Rows.Count
        strNameTraitement = p_range.Cells(intLigne, COLONNE_LIBELLE)
        For intColonne = 2 To p_range.Columns.Count
            If p_range(intLigne, intColonne) <> vbNullString Then
                Set range_ = p_range(LIGNE_EN_TETE, intColonne)
                intDay = Left(range_.Value, 2)
                If Not copyToMonthSheet(intDay, strNameTraitement) Then
                    MsgBox "erreur lors du traitement de la plage : " & vbCrLf & CStr(p_range.Address), vbOKOnly
                    Exit Function
                End If
            End If
        Next
    Next
End Function
...

Erreur d'exécution '13':
Incompatibilité de type

OK on oublie, c'est un problème de format. Il veut prendre les 2 premiers caractères et don il tombe sur '3/'. Je regarde plus loin...

[SfJ5Rpw8]

....
Bon, quand le lance la macro j'ai une erreur en rouge : ..

bonjour, tout ce que vous avez pu relevé est que l'erreur s'affichait en rouge sous excel ?

[QuestVba]

Bonjour,

bonjour, tout ce que vous avez pu relevé est que l'erreur s'affichait en rouge sous excel ?

J'ai été trop vite pour mon premier message. Deux petits trucs modifiés :

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
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
Option Explicit
 
Public Const COLONNE_LIBELLE = 1
Public Const LIGNE_EN_TETE = 1
Public gWSManageSheet As Worksheet
Public gWSMonth As Worksheet
 
Public Function manageRange(ByVal p_range As Range) As Range
 
    Dim intLigne    As Integer
    Dim intColonne  As Integer
    Dim strNameTraitement As String
    Dim intDay As Integer
    Dim range_ As Range
 
    For intLigne = 2 To p_range.Rows.Count
        strNameTraitement = p_range.Cells(intLigne, COLONNE_LIBELLE)
        For intColonne = 2 To p_range.Columns.Count
            If p_range(intLigne, intColonne) <> vbNullString Then
                Set range_ = p_range(LIGNE_EN_TETE, intColonne)
                'intDay = Left(range_.Value, 2)
                intDay = Left(Format(range_.Value, "dd/mm/yyyy"), 2)
                If Not copyToMonthSheet(intDay, strNameTraitement) Then
                    MsgBox "erreur lors du traitement de la plage : " & vbCrLf & CStr(p_range.Address), vbOKOnly
                    Exit Function
                End If
            End If
        Next
    Next
End Function
 
Public Function copyToMonthSheet(ByVal pDay As Integer, ByVal pTraitement As String) As Boolean
    Dim intTraitementRow As Integer
    Dim i As Integer
    intTraitementRow = 0
    copyToMonthSheet = True
    For i = 1 To lastRow(gWSMonth)
        If LCase(gWSMonth.Range("A" & i)) = LCase(pTraitement) Then
            intTraitementRow = i
            Exit For
        End If
    Next
    If intTraitementRow = 0 Then
        copyToMonthSheet = False
        Exit Function
    End If
    With gWSMonth.Cells(intTraitementRow, pDay + 1)
        .Value = "X"
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
    End With
End Function
 
Public Function isInCollection(ByVal pCol As Collection, pStr As String) As Boolean
    Dim i As Integer
    isInCollection = False
    If pCol.Count < 1 Then Exit Function
    For i = 1 To pCol.Count
        If Trim$(pCol(i)) = Trim$(pStr) Then
            isInCollection = True
            Exit For
        End If
    Next
End Function
 
Public Sub searchInCollectionAndDestroy(ByVal pCol As Collection, pStr As String)
    Dim i As Integer
    If pCol.Count < 1 Then Exit Sub
    For i = 1 To pCol.Count
        If pCol(i) = Trim$(pStr) Then pCol.Remove (i)
        Exit For
    Next
End Sub
 
Public Sub manageSheet(ByVal pStrName As String)
    Dim sheet_ As Worksheet
    Dim blnExist As Boolean
    For Each sheet_ In ThisWorkbook.Sheets
        If sheet_.Name = pStrName Then
            blnExist = True
            If MsgBox("Feuille existante, écraser ?", vbYesNo + vbQuestion) = vbYes Then
                sheet_.Cells.Clear
                Set gWSMonth = sheet_
            End If
        End If
    Next
    If Not blnExist Then
        Set gWSMonth = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        gWSMonth.Name = pStrName
    End If
End Sub
 
Public Sub makeHeadLine()
    Dim col_ As Collection
    Dim i As Integer
    Dim firstDay As Integer
    Dim lastDay As Integer
    Dim strMonth As String
 
    firstDay = CInt(Format(DateSerial(Year(Now), Month(Now), 1), "d"))
    lastDay = CInt(Format(DateSerial(Year(Now), Month(Now) + 1, 0), "d"))
    strMonth = Format(Now, "mmmm")
 
    Set col_ = New Collection
    Set gWSManageSheet = ThisWorkbook.Sheets("Planning")
    Call manageSheet(strMonth)
    For i = 1 To lastRow(gWSManageSheet)
        If Not isInCollection(col_, gWSManageSheet.Range("A" & i)) Then
            col_.Add Trim$(gWSManageSheet.Range("A" & i).Text)
        End If
    Next
 
    Call searchInCollectionAndDestroy(col_, "Traitement ITINP")
 
    gWSMonth.Range("A1") = Trim$("Traitement ITINP")
    For i = firstDay To lastDay
        gWSMonth.Cells(LIGNE_EN_TETE, i + 1) = DateSerial(Year(Now), Month(Now), i)
        gWSMonth.Cells(LIGNE_EN_TETE, i + 1).NumberFormat = "dd/mm"
    Next
 
    For i = 1 To col_.Count
        gWSMonth.Range("A" & i + 1) = col_(i)
    Next
 
End Sub
 
Public Sub main()
    Dim lIntIndex1  As Integer
    Dim lIntIndex2  As Integer
    Dim i           As Integer
    Dim range_      As Range
    Dim cell1_      As Range
    Dim cell2_      As Range
 
    Set gWSManageSheet = ThisWorkbook.Sheets("Planning")
 
    i = 1
    lIntIndex1 = 1
    lIntIndex2 = 1
 
    Call makeHeadLine
 
    For i = 2 To lastRow(gWSManageSheet) + 1
        If LCase(gWSManageSheet.Range("A" & i).Text) <> "traitement itinp" And LCase(gWSManageSheet.Range("A" & i).Text <> vbNullString) Then
            lIntIndex2 = i
        Else
            Set cell1_ = gWSManageSheet.Cells(lIntIndex1, COLONNE_LIBELLE)
            Set cell2_ = gWSManageSheet.Cells(lIntIndex2, lastColumn(gWSManageSheet, lIntIndex1))
            Set range_ = gWSManageSheet.Range(cell1_, cell2_)
            Call manageRange(range_)
            lIntIndex1 = i
            lIntIndex2 = i
        End If
    Next
End Sub
 
Public Function lastRow(ByVal pws As Worksheet) As Integer
    lastRow = pws.UsedRange.SpecialCells(xlCellTypeLastCell).Row
End Function
 
Public Function lastColumn(ByVal pws As Worksheet, ByVal pRow As Integer) As Integer
    lastColumn = pws.Cells(pRow, 128).End(xlToLeft).Column
End Function

Cela a l'air de fonctionner. A voir à tête reposée car le code a l'air génial.

[Nako_lito]

si ça bloque sur un nombre de caractère (3 au lieu de 03), utilise la méthode inStr sur le caractère "/", ca permettra de retourner uniquement ce qui est a gauche du /, comme ça, plus de soucis avec le format

[QuestVba]

Bonsoir,

J'ai testé, retesté et cela fonctionne ......... PARFAITEMENT. Quel as ! Quand je vois le temps que tu as mis, c'est super génial !




Comment plusser, plusser ........... !

[patricktoulon]

Bonjour

ouais!! ca fait beaucoup de code pour pas grand chose a mon avis

reprenons
tu a 2 tableaux
l'un avec les données l'autre vide

dans le tableau de donnée tu n'a pas trouver mieux que de mettre ses dates différentes dans une même colonne

bon d'accords si tu veux

mais malgré tout la structure de ton tableau de réception t'offre une possibilité qui frappe a l'œil

tu me dira mais c'est quoi qui tape a l'œil ?

moi je te dis c'est les dates et la on en rigole tout les deux
pourquoi?
parce que le jour des dates correspondent au index de colonne
et donc c'est d'une simplicité fulgurante
2 boucle sur les lignes et colonnes du tableau de donnée te donne la ligne et la colonne de destination
comment:
en bouclant sur les ligne a l'intérieur de la boucle colonne on récupère l'index de colonne de destination "DANS LA DATE " et non pas par la colonne
donc si la ligne en cellule colonne "B" contient "traitement itinp" on récupère le jour de la dates de la cellule par les 2 variable des deux boucles a savoir "lig" et "col"
si il n'y a pas traitement..... en ligne et colonne "B" alors c'est une donnée
bref je te propose 14 lignes qui feront tres bien l'affaire et excuse moi si j'arrive un peu tard

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
Sub transformetableau()
    Range("c19:w24") = "" ' on vide le tableau de destination
    For col = 3 To 9 'on boucle sur les colonnes du tableau des données
        For lig = 1 To 14 ' on boucle sur les lignes du tableau des données
            'si la cellule en ligne "lig" et colonne 2="traitemnt.... et la cellule en ligne "lig" et colonne"col"
            'est une date alors  la colonne du tableau de destination "colf" se sera le jour de la date
            If Cells(lig, 2) = "Traitement ITINP" And Cells(lig, col) Like "*/*" = True Then
                colf = Val(Split(Cells(lig, col), "/")(0))
            Else
              'si la condition du dessu n'est pa remplie alors c'est une données et si elle n'est pas vide
                If Cells(lig, col) <> "" Then
                   sujet = Cells(lig, 2)'le sujet (paiments,digifam,etc....)est le sujet
                    With Sheets("Planning").Range("b19:b24")
                        'si le sujet est trouver avec la fonction "find" dans le tableau de destination alors se sera la ligne du jujet
                        'et la variable "colf"sera l'index de la colonne
                        If Not .Find(sujet, LookIn:=xlValues) Is Nothing Then Cells(.Find(sujet, LookIn:=xlValues).Row, colf) = "X"
                    End With
                End If
            End If
        Next lig
    Next col
End Sub

EDIT:
j'ai commenté le code pour plus de compréhension,si tu enleve les lignes vertes il reste plus grand chose

et comme tu es sensé avoir les mêmes sujets en colonnes "b" sur les 2 tableaux et comme je suis un peu dingue dans mon genre
on va ller a l'essentiel
encore moins de code

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
 
sub transformetableau2()
    With Sheets("Planning")
        .Range("c19:w24") = ""
        For col = 3 To 9
            For lig = 1 To 14
                If .Cells(lig, 2) = "Traitement ITINP" Then
                    colf = Val(Split(.Cells(lig, col), "/")(0))
                Else
                    .Cells(.Range("b19:b24").Find(.Cells(lig, 2), LookIn:=xlValues).Row, colf) = IIf(.Cells(lig, col) <> "", "X", "")
                End If
            Next lig
        Next col
    End With
End Sub

ca te suffit ou je réduit encore ??

[Nako_lito]

Outre le concours de gros kiki pour montrer qui peut faire le moins de ligne de code, il y a plusieurs chose que tu n'intègre pas dans ton code :
1 - le tableau souhaité n'existe pas dans le classeur, donc tu ne peux pas te baser dessus pour faire ton extraction de données (du coup, ton deuxième code ne fonctionne pas chez moi).
2 - les déclaration de variable ? Quelque part ? Le variant, c'est sale.
3 - l'exactitude des variable et des références utilisée ? Si cette personne fait du traitement excel, on peut facilement en déduire qu'il doit avoir plusieurs classeur Excel ouvert en même temps, donc utiliser "sheets("planning") est très risqué, et pour un néophyte, repérer l'erreur va prendre 3 plombes.
4 - La portabilité de ton code et son évolutivité ? Pour ta boucle sur lig par exemple, si demain, y'a 16 lignes qui sont dans le tableau ? Bah ça fait 2 lignes ignorées et si l'utilisateur n'est pas programmeur, il restera avec ses deux lignes sans comprendre pourquoi y'a un écart chaque semaine.

Il faut certes épurer le code pour éviter de réinventer la roue, mais il ne faut pas oublier les fondamentaux. Il vaut mieux une centaine de lignes (dont 50 sont réutilisable dans d'autre programmes) que 14 utilisable qu'une fois. Après, c'est mon avis...

[patricktoulon]

bonjour

personnellement je me suis basé sur l'exemple qui a posté avec sa demande

maintenant concernant le nombre de ligne
au grand dieu!!! changer 14 pour plus c'est énorme comme travail hein!!! et pareil pour les colonnes


pour le tableau de destination qui n'existerait pas au grand dieu création d'un tableau de 5 lignes avec les nom serait un travail trop fastidieux hein!!!


quand la portabilité du code d'après ce que j'ai vu sur les réponses précédentes je n'ai rien a craindre de ce coté la

et ca c'est le mien d'avis !


et c'est pas une histoire de gros KIKI

Edit/
Pour les variables non déclarées je plaide coupable

mais quand je vois le nombre de variables utilisées dans les réponses précédentes et le moteur utilisé et que je sais la place que ca prend dans la mémoire
je me dis que ca fait beaucoup de ressource pour 5 ligne de tableau sur 23 colonnes alors portabilité prend tout son sens a mon avis

[QuestVba]

Bonjour à tous les deux !

Bon puisque vous êtes très concernés (euh concernés ou ) par mon problème , je donne quelques explications.

Le fichier que j'ai fourni est très légèrement différent de celui que je reçois en brut (deux exemples en PJ). Quoique. La colonne B est retirée et le texte 'Verwerking / Traitement ITINP' est modifié en 'Traitement ITINP'. Plus de couleur de fond ou de police colorées.

dans le tableau de donnée tu n'a pas trouver mieux que de mettre ses dates différentes dans une même colonne

Ben c'est pas moi sinon j'aurais fait directement le tableau dans le bon sens.

Donc, au départ, je n'ai qu'un seul tableau sur une seule feuille. Le but du code est de créer un tout nouveau tableau avec en ligne, les traitements et les dates en colonnes. Je sais également que vous allez dire que c'est le fout... car des dates ne sont pas concernées par le mois en cours (29.09 et 30.09 sur le mois d'octobre).

Donc effectivement, le code de Nako_lito répond à la question. Juste peut-être le Now() qui m'oblige à traiter le tableau en cours et non un tableau passé. Mais de toutes façons, c'est pas trop le but. Le seul risque est que je reçoive le fichier de 12/2014 vers le 27.11.2014. Donc, il faudra être vigilent.

Quant à patricktoulon, c'est vrai que ton code est court et alléchant. Juste à adapter pour le parfaire à la situation.

A plus tard certainement dans d'autres posts.

[patricktoulon]

re
bon j'ai regardé tes dux fichier et

pour l'adapter il faudrait faire simplement une liste de sujets pour tous les avoir tout simplement je vois pas ou il est le problème les colonnes sont les même en plus

enfin c'est toi qui vois

[QuestVba]

Effectivement, ce serait plus cool d'avoir tous les traitements. Mais évidemment, d'un mois à l'autre, certains peuvent apparaître et d'autres disparaitre.

Mais je suis également d'accord avec toi lorsque tu dis qu'il serait beaucoup plus facile d'avoir un canevas de tableau dans lequel on pourrait injecter les données en fonction des lignes et colonnes.

[patricktoulon]

re
non tu n'a pas compris le canevas serait dynamique

regarde la structure des exemple très court que je t'avais donné il est parfaitement possible d'y ajouter la création des items pour le find final de la boucle
rien de bien compliqué
donc en début de boucle test de l'existence de l'item(titre) et ajout si c'est non
et ensuite le reste du code

résultat avec une seul boucle ligne et boucle colonne tu a ton tableau

question parce que rien que pour mon plaisir je vais t'en faire un

les titres sont bien la colonne B dans les deux derniers exemples ?
c'est tout ce que je veux savoir

[QuestVba]

Re-, patricktoulon,

Les titres se trouvent toujours dans la colonne A. Au plaisir.

[patricktoulon]

re
bonsoir
si les titres se trouvent en colonne A

j'ai repris mon exemple le plus court
regarde

j'ai un seul bémol je n'ai pas encore résolu le comment gérer le 29 et 30 du mois prescedent mais ca va venir

je supprime les doublons en même temps

colle ca dans un module standard dans ton exemple 201410

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
Sub transformetableau2()
    Dim newsheet
    Set newsheet = Sheets.Add(After:=Sheets(Sheets.Count))
    newsheet.Name = "tableau-transposé": newsheet.Columns("A:A").ColumnWidth = 35: newsheet.Columns("B:BG").ColumnWidth = 3
 
    With Sheets(1)
        For col = 3 To 9
            For lig = 1 To .Cells(Rows.Count, 2).End(xlUp).Row
                If .Cells(lig, 1) = "Verwerking / Traitement ITINP" Then
                    colf = Val(Split(.Cells(lig, col), "/")(0))
                    newsheet.Cells(1, 1) = .Cells(lig, 1)
                    newsheet.Cells(1, colf + 1) = colf
                Else
                    If newsheet.Range("A1:A" & Rows.Count).Find(Sheets(1).Cells(lig, 1), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
                        newsheet.Cells(newsheet.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1) = Sheets(1).Cells(lig, 1)
                       newsheet.Cells(newsheet.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).BorderAround ColorIndex:=0, Weight:=xlThin
                        newsheet.Cells(newsheet.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).EntireRow.Interior.Color = Sheets(1).Cells(lig, 1).Interior.Color
                  End If
 
                        newsheet.Cells(newsheet.Range("A1:A" & Rows.Count).Find(Sheets(1).Cells(lig, 1), LookIn:=xlValues).Row, colf + 1) = IIf(Sheets(1).Cells(lig, col) <> "", "X", "")
               newsheet.Cells(newsheet.Range("A1:A" & Rows.Count).Find(Sheets(1).Cells(lig, 1), LookIn:=xlValues).Row, colf + 1).BorderAround ColorIndex:=0, Weight:=xlThin
 
                 End If
            Next lig
        Next col
    End With
 newsheet.UsedRange.BorderAround ColorIndex:=0, Weight:=xlThick
   End Sub

ca te montre un peu mon idée sur la mécanique

reste une mise en forme des cellules (retour a la ligne si le texte est trop grand etc...)

[Nako_lito]

comment sont gérés les jours qui n'ont pas de traitement (qui n'apparaissent pas dans le tableau 1) ?
Pour pas juste avoir du 3 au 23 du mois ?

remplace la méthode

Code :

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

End(xlUp).Row

par

Code :

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

.UsedRange.SpecialCells(xlCellTypeLastCell).Row

[patricktoulon]

Allez une ultime version
activation de la librairie Scripting run time
plus rapide ,plus court
toujours avec une double boucle ligne colonne

on ne travaille plus sur le newsheet mais dans un tableau en mémoire
donc la fonction find est remplacer par la valeur de litem du dico

je met plus de lignes de code a mettre le nouveau tableau en forme que de faire le boulot

tiens regarde ceci :

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
Sub tableau_transposé_V3()
    Dim dico, lig As Integer, col As Integer, coltab As Long, i As Long, tablo(1000, 34)
    Set dico = CreateObject("Scripting.Dictionary")
    With Sheets(1)
        For col = 3 To 9
            For lig = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
                If Not dico.exists(.Cells(lig, 1).Value) Then
                    i = i + 1: dico(.Cells(lig, 1).Value) = i: tablo(i, 1) = .Cells(lig, 1)
                End If
                If .Cells(lig, 1) = "Verwerking / Traitement ITINP" Then
                    coltab = Val(Split(.Cells(lig, col), "/")(0)): tablo(1, coltab + 1) = .Cells(lig, col)
                Else
                    'tablo(dico(.Cells(lig, 1).Value), coltab + 1) = .Cells(lig, col) 'si tu veux les données reelles
                    tablo(dico(.Cells(lig, 1).Value), coltab + 1) = IIf(.Cells(lig, col) <> "", "X", "")    ' si tu prefere les "X"
                End If
            Next lig
        Next col
    End With
'*******************************************************************************************************************************************
' le boulot est fini on envoie le tableau dans un nouveau sheet
    With Sheets.Add(After:=Sheets(Sheets.Count))
        .Name = "tableau-transposé": .Columns("A:A").ColumnWidth = 35: .Columns("B:BG").ColumnWidth = 4: .Columns("A:A").WrapText = True
        .Cells(1, 1).Resize(i, 34) = tablo
        With .Cells(1, 1).Resize(i, 34)
            .HorizontalAlignment = xlCenter
            .Cells(1, 1).Resize(i, 34).VerticalAlignment = xlCenter
            .Borders(xlEdgeLeft).LineStyle = xlContinuous: .Borders(xlEdgeTop).LineStyle = xlContinuous
            .Borders(xlEdgeRight).LineStyle = xlContinuous: .Borders(xlInsideVertical).LineStyle = xlContinuous
            .Borders(xlInsideHorizontal).LineStyle = xlContinuous
            With ActiveWindow
                .SplitColumn = 0
                .SplitRow = 1
                .FreezePanes = True
            End With
        End With
    End With
'********************************************************************************************************************************************
End Sub