Discussion :

[Nako_lito]

38 lignes !!!!

(Je rigole). . l'important ayant été de débloquer QuestVBA

[QuestVba]

Bonjour, patricktoulon,

Bon ben je coince sur un truc car il me crée bien une nouvelle feuille mais après le traitement elle est toute blanche. Rien de visible ???

[patricktoulon]

tu a du zapper quelque chose

prend le fichier il y a les deux dernières versions dans le module

[patricktoulon]

re
nako_lito

seules les 18 premières lignes sont le moteur
le reste c'est du superflu(ajout du sheet ,mise en forme des cellules(bordures , alignement ,etc.....)

[patricktoulon]

salut questvba

d'après l'idée de ma double boucle j'ai revue la copie

maintenant la méthode est infaillible
on gère les jour du mois précèdent et les jour du mois suivant
pour cela j'ai utiliser 2 dico :dicosujet pour les titre en colonne A:dicodate pour les dates
le reste est resté relativement pareil sauf que les colonne sont gérées par la variable "coltab"

aucune erreur possible

un exemple 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
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
Option Base 1
Sub tableau_transposé_V4()
    Dim dicosujet, lig As Integer, col As Integer, coltab As Long, i As Long, tablo(1000, 100), e As Long
    Set dicosujet = CreateObject("Scripting.Dictionary"): Set dicodate = CreateObject("Scripting.Dictionary")
    With Sheets(1)
        For lig = 1 To .Cells(Rows.Count, 1).End(xlUp).Row
            For col = 3 To .Cells(1, Columns.Count).End(xlToLeft).Column
            If Not dicosujet.exists(.Cells(lig, 1).Value) Then i = i + 1: dicosujet(.Cells(lig, 1).Value) = i: tablo(i, 1) = .Cells(lig, 1).Value
                If .Cells(lig, 1).Value Like "*Traitement ITINP" = True Then
                    oldlig = .Cells(lig, col).Row
                    If Not dicodate.exists(.Cells(lig, col).Value) Then
                        coltab = coltab + 1: dicodate(.Cells(lig, col).Value) = coltab + 1
                        tablo(1, coltab + 1) = Val(.Cells(lig, col).Value)
                    End If
                Else
                    tablo(dicosujet(.Cells(lig, 1).Value), dicodate(.Cells(oldlig, col).Value)) = IIf(Sheets(1).Cells(lig, col) <> "", "X", "")
                End If
            Next col
        Next lig
 
    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, coltab + 1) = tablo
        With .Cells(1, 1).Resize(i, coltab + 1)
            .HorizontalAlignment = xlCenter
            .Cells(1, 1).Resize(UBound(tablo), coltab + 1).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

toujours pareil la mise en forme des cellules est plus longue que le reste

je l'ai tester dans tout les sens
en rajoutant des colonnes ,doublons etc.....
on obtiens toujours un tableau avec autant de colonnes que de dates (dans l'ordre biensur )
et aucun doublons dans la colonne A