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 !

[Quentin77170]

Bonjour à toi,

Je ne pense pas avoir tout compris à tes tableaux, pourrais-tu nous en joindre un extrait ? Avant tout, je ne sais pas si tu les as utilisées, mais il y a quelques astuces pour gagner en temps de traitement, parfois énormément, même :

Code :

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

1
2
3
4
5
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
'[TON CODE]
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

[MobyKDIK]

D'abord merci de ta réponse !
J'ai bien ajouté dès le départ les commandes classiques d'optimisation :

Code :

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

1
2
3
4
5
 
Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    ActiveSheet.DisplayPageBreaks = False
    Application.Calculation = xlCalculationManual

Je n'arrive pas à le mettre en pièce jointe, je ne peux que te fournir une image plus claire, plus complète

AVANT :


APRES :


Tu peux y voir qu'avant les cellules description sont fractionnées, celles d'à côté sont fusionnées
Et après je l'ai ai réunies en une ligne pour chaque événement

[Theze]

Bonjour,

Sans classeur exemple difficile de tester mais regarde ce code sur une copie de ton classeur pour voir déjà le résultat obtenu et ce qui reste à faire :

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
 
Sub Test()
 
    Dim WsTicket As Worksheet
    Dim Plage As Range
    Dim Cel As Range
 
    Set WsTicket = Worksheets("Feuil1") '<--adapter le nom de la feuille
 
    'défini la plage sur les cellules utilisées
    With WsTicket
 
        Set Plage = .Range(.Cells(1, 1), _
                    .Cells(.Cells.Find("*", .[A1], -4123, , _
                    1, 2).Row, .Cells.Find("*", .[A1], -4123, , _
                    2, 2).Column))
 
        'ou :
        'Set Plage = .UsedRange
 
    End With
 
    'supprime toutes les fusions
    Plage.MergeCells = False
 
    'boucle sur les cellules de la plage contenant une valeur et remplace le saut de ligne par un espace
    For Each Cel In Plage.SpecialCells(xlCellTypeConstants)
 
        'fonction Excel "Epurage", problème ici, les mots vont être collés les uns au autres !
        'Cel.Value = Application.WorksheetFunction.Clean(Cel.Value)
        Cel.Value = Replace(Cel.Value, Chr(10), " ") 'remplace par un espace
 
    Next Cel
 
End Sub

Hervé.

Ici, en passant par un tableau intermédiaire :

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
 
Sub Test2()
 
    Dim Tbl
    Dim Plage As Range
    Dim I As Long
    Dim J As Long
 
    Set Plage = Worksheets("Feuil1").UsedRange '<--adapter le nom de la feuille
 
    Tbl = Plage
 
    For I = 1 To UBound(Tbl, 1)
 
        For J = 1 To UBound(Tbl, 2)
            Tbl(I, J) = Replace(Tbl(I, J), Chr(10), " ") 'remplace par un espace
        Next J
 
    Next I
 
    Plage = Tbl
 
End Sub

Hervé.

[patricktoulon]

bonjour
c'est un cas assez récurent les importation mal concues

selon ta preùiere capture je dis bien selon ta 1 ere capture supprimer les sauts de ligne n'est pas ce qu'il faut faire
en effet les données sont bien sur plusieur lignes et pas dans une seule cellule avec des saut de ligne ce qui est tout a fait diférent dans le sens ou la manoeuvre va etre completement différente

solution
boucler sur la colonne A recupérer l'index de ligne
avec l'index de ligne on a deja la reference A et ticket
il faut maintenant récupérer dans une variable le contenu de la plage partant de l'index jusque au suvant -1 de la colonne C on obtiens ainsi la colonne C en un seul morceau
on fait pareil pour la dolonne D
ensuite on recupere E,Fet G
et le tour est joué
voila la marche a suivre

a moins que certaine cellule soit fusionnées comme cela semble etre le cas pour B,C,E et G (je ne vois pas le gridline dans ces colonnes
dans ce cas la c'est encore un peu plus compliqué mais la il nous faut un classeur exemple avec au moins 2 ou 3 cas

[MobyKDIK]

Je vous remercie de toutes vos réponses, je n'espérais pas autant d'aide !!

Je me lance dans la lecture de tout ce que vous m'avez proposé, mais avant je vous envoie un exemple excel des tableaux sur lesquels je travaille, j'ai essayé d'enlever des infos pour que le confidentiel soit respecté.
Encore merci !
forum.xlsx