Discussion :

[MobyKDIK]

Salut à tous
Je fais appel à votre expérience en Excel et en VBA pour me donner des conseils quant à ma macro
Il s'agit du traitement d'une extraction depuis un logiciel mal foutu. Ce logiciel traite d'événements de maintenance, et me sort un tableau excel où chaque ligne devrait correspondre à un événement, les colonnes en seraient les différentes info (date, numéro etc)
OR cette extraction crée une nouvelle ligne à chaque fois qu'il y a un retour à la ligne dans un champ d'origine : typiquement si dans le champ description le mec qui l'a écrit a mis 2 sauts de ligne, PAF je me retrouve avec 3 lignes au lieu d'une !
Une image vaut mieux que toute mon explication :
Voila ce que j'ai au départ :



et voila ce que je veux obtenir :



J'y arrive mais cela prend trop longtemps, cela fait planter mon ordi, et si je veux que cela intéresse d'autres collègues, je dois vraiment réussir à rendre tout ça plus rapide !
Voila donc mon code en question (je vous épargne les lignes de mise en forme de base), mon besoin est surtout sur la partie "concaténation" :

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
 
Sub EXTRACT_Ticket_Layout()
 
    With wsticket
 
    '===============================================================
    '%%%%%%%%%%%%%%%%%%%%%%% Paramétrisation %%%%%%%%%%%%%%%%%%%%%%%
    rtickcol = .Cells.Find(What:="INC00*", SearchOrder:=xlByRows).Offset(-1, 0).row
    If .Cells(rtickcol, 1) = "" Or wsticket.Cells(rtickcol, 1) Is Nothing Then
        ctickfirst = .Cells(rtickcol, 1).End(xlToRight).Column
    Else
        ctickfirst = 1
    End If
    cticklast = .Cells(rtickcol, ctickfirst).End(xlToRight).Column
    '===============================================================
 
 
    '===============================================================
    '%%%%%%%%%% Suppression des colonnes et lignes vides %%%%%%%%%%%
    If Not rtickcol = 1 Then
        For i = rtickcol - 1 To 1 Step -1
            .Rows(i).Delete Shift:=xlUp
        Next i
        rtickcol = 1
    End If
 
    If Not ctickfirst = 1 Then
        For i = ctickfirst - 1 To 1 Step -1
            .Columns(i).Delete Shift:=xlToLeft
        Next i
        cticklast = cticklast - ctickfirst + 1
        ctickfirst = 1
    End If
    '===============================================================
 
 
 
 
    '===============================================================
    '%%%%%%%%%%%%%% Défusion de toutes les cellules %%%%%%%%%%%%%%%%
    With .Cells
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    '===============================================================
 
 
 
 
    '===============================================================
    '%%%%%%%%%%%%%%% Concaténation sur une cellule %%%%%%%%%%%%%%%%%
    cticknumber = .Cells.Find(What:="INC00*", SearchOrder:=xlByRows).Offset(-1, 0).Column
    rtickend = .Cells(65536, cticknumber).End(xlUp).Offset(1, 0).row - 1
 
    itickpre = rtickend
    iticknext = .Cells(rtickend + 1, cticknumber).End(xlUp).row
 
    'tant qu'on est pas au dernier avis
    While Not iticknext = rtickcol
        'si il y a des lignes vides à concaténer
        If Not iticknext = itickpre Then
            For i = itickpre To iticknext + 1 Step -1
                For j = ctickfirst To cticklast
                    If Not (.Cells(i, j) Is Nothing Or .Cells(i, j) = "") Then
                        'si il y a un signe égal on passe en format texte
                        If Not InStr(.Cells(i, j), "=") = 0 Then
                            .Cells(i, j).NumberFormat = "@"
                        End If
                        If Not (.Cells(i - 1, j) Is Nothing Or .Cells(i - 1, j) = "") Then
                            If Not InStr(.Cells(i - 1, j), "=") = 0 Then
                                .Cells(i - 1, j).NumberFormat = "@"
                            End If
                            .Cells(i - 1, j) = .Cells(i - 1, j) & Chr(10) & .Cells(i, j)
                        Else
                            .Cells(i - 1, j) = .Cells(i, j)
                        End If
                        If .Cells(i - 1, j).NumberFormat = "@" Then
                            .Cells(i - 1, j).NumberFormat = "General"
                        End If
                    End If
                Next j
                .Rows(i).Delete
            Next i
 
        End If
        itickpre = iticknext - 1
        If .Cells(itickpre, cticknumber) Like "INC00*" Then
            iticknext = itickpre
        Else
            iticknext = .Cells(iticknext, cticknumber).End(xlUp).row
        End If
    Wend
    rtickend = .Cells(65536, cticknumber).End(xlUp).Offset(1, 0).row - 1
    '===============================================================

Voila Voila, j'espère intéresser des gens et je remercie toute aide ou suggestion, je ne vois pas trop comment améliorer tout ça !