Macro classement complexe

Version imprimable

Voir 40 message(s) de cette discussion en une page

09/02/2017, 14h52
Matthieu.boillon

1 pièce(s) jointe(s)

Macro classement complexe

Bonjour,
Je n'ai d'autre choix que de me tourner vers vous aujourd'hui car je suis confronté à un pb complexe que je n'arrive pas à solutionner.

J'aimerais créer une macro permettant au tableau en pj de trier les lignes en fonction de leur "IDENTIFIANT" et Technologie.

Contexte :

Dans la colonne "technologie" on retrouve
- EPP
- PPP
- PSP
etc ..

"E" symbolisant la début et la fin d'une liaison
"P" et "S" symbolisant le type de liaison que c'est
Exemple avec le code "EPS":
La lettre du milieu "P" définit le type de la liaison étudié et les deux autres lettres "E" et "S" définissent ce qu'on retrouve avant et après cette liaison.
donc nous ici nous somme sur une liaison qui commence "E" de type "P" et qui est suivie d'une liaison type "S". (j’espère que je ne vous ai pas perdu ^^ ...)

De plus dans la colonne "IDENTIFIANT"
On retrouve un ID composé de 2 paquet de 10 chiffres et lettre ex : "68224E0033 68224E0031" le paquet a gauche "68224E0033" est l'ID de la liaison précédente et le paquet à droite celui de la liaison suivante.

ex:
LUTTEC4008 CA 5757,2 711715249 68218P0002 68218E0027 444 EPP LUTTE
LUTTEC4008 CA 5757,2 711715259 68218E0027 68218P0003 96 PPE LUTTE

Sur les deux lignes précédentes, j'ai le code EPP (1ere ligne) donc je sais que la liaison type "P" commence et que la liaison suivante est de type "P". Il faut donc chercher une ligne commençant par le code "PP" puis comparer le paquet "68218E0027" de droite de la 1ere ligne avec le paquet de gauche de la ligne que l'on cherche (ici ligne 2).

Ma question est : Est-il possible de faire une macro permettant de faire la recherche automatique et l'association de ses lignes ?

J’espère avoir été clair au minimum ...
Merci d'avance
09/02/2017, 16h00
Invité

Citation:

Envoyé par Matthieu.boillon

Bonjour,

Voir avec le BERE Normandie d'ENEDIS s'il travaille toujours avec le tableur "Segment" ou son équivalent. Cet outil permet à partir d'une extraction PRAO de calculer la résistance et la réactance d'un circuit depuis un noeud du réseau HTA jusqu'à sa cellule départ du poste source. Il possède donc l'algorithme pour trouver les liaisons de noeud à noeud.
Ce logiciel avait été réalisé pour modéliser les productions décentralisées dans le logiciel Harmoniques. Le besoin doit donc toujours être d'actualité.

Un peu de gymnastique basique

Code:

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
Sub Correspondances()
Dim LastLig As Long, i As Long, Cpt As Long
Dim c As Range
 
Application.ScreenUpdating = False
'On copie la feuille initiale
Feuil1.Copy After:=Feuil1
With ActiveSheet
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
 
    Application.DisplayAlerts = False
    'on scinde la colonne Identifiant en 25
    .Columns("F:F").Insert
    .Range("E2:E" & LastLig).TextToColumns Destination:=.Range("E2"), DataType:=xlDelimited, Space:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2))
    .Columns("I:J").Insert
    'et la colonne Technologie en 3
    .Range("H2:H" & LastLig).TextToColumns Destination:=.Range("H2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(1, 1))
    .Range("I2:I" & LastLig).TextToColumns Destination:=.Range("I2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(1, 1))
    Application.DisplayAlerts = True
 
    'on concatène en L le suivant,le type et l'id suivant
    'et en M le précédent, le type et l'id précédent
    With .Range("L2:L" & LastLig)
        .Formula = "=J2&I2&F2"
        .Value = .Value
    End With
    With .Range("M2:M" & LastLig)
        .Formula = "=H2&I2&E2"
        .Value = .Value
    End With
 
    'on parcoure les colonnes L et I pour indiquer en N les correspondances
    For i = 2 To LastLig
        Set c = .Range("M2:M" & LastLig).Find(.Range("L" & i), LookAt:=xlWhole)
        If Not c Is Nothing Then
            Cpt = Cpt + 1
            c.Offset(, 1) = Cpt & "A"
            .Range("N" & i) = Cpt & "B"
            Set c = Nothing
        End If
    Next i
End With
End Sub

09/02/2017, 16h21
Matthieu.boillon

Merci mercatog, mais j'ai peur que ta proposition ne fonctionne pas .. (ou alors je ne comprend pas comment apparaissent les correspondances)

Peux-tu m'en dire plus ?
09/02/2017, 16h26
mercatog

J'ai aussi peur que la proposition ne fonctionne pas tant que tu n'as pas testé et que les maigres commentaires ne t'ont pas aidé:

1. je copie la feuille (pour garder l'initiale)
2. je sépare Identifiant en 2 colonnes
3. je sépare Technologie en 3 colonnes (chacune comporte une lettre)
4. en L je concatène Suivant/Type/Identifiant Suivant
5. en M je concatène Précédent/Type/Identifiant Précédent
6. je compare la colonne L avec M et j’inscris le résultat en N
09/02/2017, 16h40
Matthieu.boillon

mercatog

Citation:

6. je compare la colonne L avec M et j’inscris le résultat en N

L'idée serait de pouvoir classer les lignes contenants un bout ID identique ensemble.

En ce qui concerne les valeurs 1A, 1B etc je n'arrive pas a comprendre comment les exploiter à la fin ..
09/02/2017, 16h43
mercatog

1A et 1B sont des lignes correspondant au critère imposé. j'ai ajouté le A pour départ et B pour suivant

Il suffit de trier les données selon la colonne N. (tu peux enlever les lettres A et B dans le code)

Teste la version 2

Code:

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
Sub Correspondances()
Dim LastLig As Long, i As Long, Cpt As Long, Ind As Long
Dim c As Range
Dim Ap As String
 
Application.ScreenUpdating = False
'On copie la feuille initiale
Feuil1.Copy After:=Feuil1
With ActiveSheet
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
 
    Application.DisplayAlerts = False
    'on scinde la colonne Identifiant en 25
    .Columns("F:F").Insert
    .Range("E2:E" & LastLig).TextToColumns Destination:=.Range("E2"), DataType:=xlDelimited, Space:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2))
    .Columns("I:J").Insert
    'et la colonne Technologie en 3
    .Range("H2:H" & LastLig).TextToColumns Destination:=.Range("H2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(1, 1))
    .Range("I2:I" & LastLig).TextToColumns Destination:=.Range("I2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(1, 1))
    Application.DisplayAlerts = True
 
    'on concatène en L le suivant,le type et l'id suivant
    'et en M le précédent, le type et l'id précédent
    With .Range("L2:L" & LastLig)
        .Formula = "=J2&I2&F2"
        .Value = .Value
    End With
    With .Range("M2:M" & LastLig)
        .Formula = "=H2&I2&E2"
        .Value = .Value
    End With
 
    'on parcoure les colonnes L et I pour indiquer en N les correspondances
    For i = 2 To LastLig
        If .Range("N" & i) = "" Then
            Set c = .Range("M2:M" & LastLig).Find(.Range("L" & i), LookAt:=xlWhole)
            If Not c Is Nothing Then
                If c.Offset(, 1) <> "" Then
                    Ind = c.Offset(, 1)
                Else
                    Cpt = Cpt + 1
                    Ind = Cpt
                End If
                .Range("N" & i) = Format(Ind, "0000")
                c.Offset(, 1) = Format(Ind, "0000")
            End If
        End If
    Next i
    .Range("A2:N" & LastLig).Sort Key1:=.Range("N2"), Header:=xlNo
End With
End Sub

09/02/2017, 17h05
Matthieu.boillon

C'est plus fonctionnel en effet.

Le seul pb maintent est que le code ne fait que la comparaison des ID et ne prends pas en compte les symboles "EPP" ...

Par exemple :
LUTTEC4008 CA 5757,2 711715275 68218E0028 68218P0005 394 P P E LUTTE EP68218P0005 PP68218E0028 5,0
LUTTEC4008 CA 5757,2 711715329 68218P0005 68218P0006 518 E P E LUTTE EP68218P0006 EP68218P0005 5,0
LUTTEC4008 CA 5757,2 711715265 68218P0003 68218E0028 98 E P P LUTTE PP68218E0028 EP68218P0003 5

Même si cette ligne rouge à le même ID que la première elle ne fait pas partie de la même liaison. c'est le même point de départ mais pas la même liaison... (il n'y a pas de connexion en réalité)
Penses-tu qu'il est possible d'écarter cette composante dans le code .. ?

Merci d'avance pour ton aide précieuse.
09/02/2017, 17h10
mercatog

Pour cet exemple, la liaison n'est elle pas P?

Là, je ne comprend pas
09/02/2017, 17h16
Matthieu.boillon

Si mais la liaison est de type P mais encadré par des "E" ce qui symbolise le début et la fin physique de cette liaison.
Alors que lorsque qu'on a "EPP" on sait que nous sommes sur une liaison de type P qui est la première mais qui est raccordé (physiquement en réalité) a une autre liaison P. (Par exemple "PPE")
Est-ce plus clair ?..
09/02/2017, 19h54
mercatog

On ne va pas tenir des liaisons de type xYx. C'est ça?

Il suffirait de tester dans la boucle à partir de la ligne 34 du dernier code si la cellule Hi est différente de Ji
09/02/2017, 20h01
Matthieu.boillon

En fait, il faudrait faire la comparaison des ID dès que l'on a quelquechose de La forme "E**" et que ça continue tant qu'on ne tombe pas sur l'intitulé "**E"
Et ce pour toutes les lignes du tableur
09/02/2017, 20h21
Matthieu.boillon

1 pièce(s) jointe(s)

J'ai mis un schéma pour aider à comprendre en pièce jointe.
Sur le schéma il y a deux liaison composé de plusieurs type de câble (ESS, SSP...) j'ai noté des ID pour exemple.
Le but du programme que j'aimerais avoir et de pouvoir reconstituer ces liaisons à partir des types de câble (choques type de câble est matérialise par une ligne dans Excel)

Le pb que j'expliquais est que je ne veux assembler que Les morceaux de câbles qui compose une liaison reliée physiquement (on peut le voir sur le schéma)
Donc EPP avec un ID 4488 ne doit pas être associé avec ESS 4488 car ils ne sont pas connecté dans la réalité

Merci d'avance pour ta précieuse contribution
Cordialement
09/02/2017, 20h31
mercatog

Citation:

Exemple avec le code "EPS":
La lettre du milieu "P" définit le type de la liaison étudié et les deux autres lettres "E" et "S" définissent ce qu'on retrouve avant et après cette liaison.
donc nous ici nous somme sur une liaison qui commence "E" de type "P" et qui est suivie d'une liaison type "S". (j’espère que je ne vous ai pas perdu ^^ ...)

Perdu OUI

Dans ton schéma je comprend mieux. Je vais essayer d'adapter

Regardes cette version 3 ( si j'ai bien compris)

Code:

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
Sub Correspondances()
Dim LastLig As Long, i As Long, Cpt As Long, Ind As Long
Dim c As Range
Dim Ap As String
 
Application.ScreenUpdating = False
'On copie la feuille initiale
Feuil1.Copy After:=Feuil1
With ActiveSheet
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
 
    Application.DisplayAlerts = False
    'on scinde la colonne Identifiant en 25
    .Columns("F:F").Insert
    .Range("E2:E" & LastLig).TextToColumns Destination:=.Range("E2"), DataType:=xlDelimited, Space:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2))
    .Columns("I:J").Insert
    'et la colonne Technologie en 3
    .Range("H2:H" & LastLig).TextToColumns Destination:=.Range("H2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(1, 1))
    .Range("I2:I" & LastLig).TextToColumns Destination:=.Range("I2"), DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(1, 1))
    Application.DisplayAlerts = True
 
    'on concatène en L le suivant,le type et l'id suivant
    'et en M le précédent, le type et l'id précédent
    With .Range("L2:L" & LastLig)
        .Formula = "=J2&F2"
        .Value = .Value
    End With
    With .Range("M2:M" & LastLig)
        .Formula = "=I2&E2"
        .Value = .Value
    End With
 
    'on parcoure les colonnes L et I pour indiquer en N les correspondances
    For i = 2 To LastLig
        If .Range("N" & i) = "" Then
            Set c = .Range("M2:M" & LastLig).Find(.Range("L" & i), LookAt:=xlWhole)
            If Not c Is Nothing Then
                If c.Offset(, 1) <> "" Then
                    Ind = c.Offset(, 1)
                Else
                    Cpt = Cpt + 1
                    Ind = Cpt
                End If
                .Range("N" & i) = Format(Ind, "0000.000")
                c.Offset(, 1) = Format(Ind * 1.01, "0000.000")
            End If
        End If
    Next i
    .Range("A2:N" & LastLig).NumberFormat = "0"
    .Range("A2:N" & LastLig).Sort Key1:=.Range("N2"), Header:=xlNo
End With
End Sub

Sinon, sur ton fichier initial, mets manuellement le résultat escompté

10/02/2017, 08h49
Matthieu.boillon

1 pièce(s) jointe(s)

Je suis désolé ce n'est pas encore ça ...
Si j'exécute ton prgm des morceaux de liaisons ne sont pas traités (5050, 505000 ...) alors qu'il font parties de la même liaison car nous sommes encore sur un type "PPP"

Javais plus un classement en tête de ce type .. (voir pj)
"Feuil1" liste de départ et "Feuil2" liste avec classement

Merci d'avance !

Version 4 (ça commence l'usine à gaz)
[Edit]

Code:

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
Sub Essai2()
Dim LastLig As Long, i As Long, k As Long
Dim Cpt As Double, Ind As Double
Dim Ap As String
Dim c As Range
 
Application.ScreenUpdating = False
Feuil1.Copy After:=Feuil1
With ActiveSheet
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
 
    Application.DisplayAlerts = False
    .Columns("F:F").Insert
    .Range("E2:E" & LastLig).TextToColumns Destination:=.Range("E2"), DataType:=xlDelimited, Space:=True, FieldInfo:=Array(Array(1, 2), Array(2, 2))
    Application.DisplayAlerts = True
 
    With .Range("J2:J" & LastLig)
        .Formula = "=MID(H2,2,1)&E2"
        .Value = .Value
    End With
    With .Range("K2:K" & LastLig)
        .Formula = "=RIGHT(H2,1)&F2"
        .Value = .Value
    End With
 
    i = 2: k = 2
    Do
        Set c = .Range("J2:J" & LastLig).Find(.Range("K" & i), LookAt:=xlWhole)
        If Not c Is Nothing Then
            Ap = c.Address
            Do
                If .Range("L" & i) <> "" Then
                    Ind = .Range("L" & i)
                Else
                    If c.Offset(, 2) <> "" Then
                        Ind = c.Offset(, 2)
                    Else
                        Cpt = Cpt + 1
                        Ind = Cpt
                    End If
                    .Range("L" & i) = Ind
                End If
                c.Offset(, 2) = Ind * 1.0001
                i = c.Row
                Set c = .Range("J2:J" & LastLig).FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Ap
        Else
            k = k + 1
            If WorksheetFunction.CountBlank(.Range("L" & k & ":L" & LastLig)) > 0 And k <= LastLig Then
                i = .Range("L" & k & ":L" & LastLig).SpecialCells(xlCellTypeBlanks).Row
            Else
                Exit Do
            End If
        End If
        DoEvents
    Loop
    .Range("L2:L" & LastLig).NumberFormat = "0"
    .Range("L2:L" & LastLig).Copy Feuil1.Range("I2")
    Application.DisplayAlerts = False
    .Delete
    Application.DisplayAlerts = True
End With
Feuil1.Range("A2:I" & LastLig).Sort Key1:=Feuil1.Range("I2"), Header:=xlNo
End Sub

10/02/2017, 14h43
Matthieu.boillon

Oui c'est vrai que je commence à avoir du mal à comprendre le code ..^^

Dernière petite question penses-tu pouvoir différencier comme ceci ? ..

G.LUSC1305 CA 4011,24 711586321 68056E0056 68056E0006 592 SPP G.LUS 5
G.LUSC1305 CA 4011,24 711586281 68056E0006 68056E0038 400 PPP G.LUS 5
G.LUSC1305 CA 4011,24 711586271 68056E0038 68056E0060 131 PPP G.LUS 5
G.LUSC1305 CA 4011,24 1657644537 68056E0060 68056E0062 239 PPE G.LUS 5 A
G.LUSC1305 CA 4011,24 711586291 68056E0060 68056E0039 132 PPP G.LUS 5 B
G.LUSC1305 CA 4011,24 1657644551 68056E0039 68056E0058 21 PPE G.LUS 5 B

Je m'explique :
Pour la ligne "68056E0060 68056E0062 239 PPE" : on remarque que c'est la fin d'une liaison du au "E"
Mais on remarque que la ligne "68056E0060 68056E0039 132 PPP" commence avec un ID comme la ligne précédente. Cela veut dire en réalité que la liaison se sépare en deux à un moment donné.
Il serait vraiment intéressant de pouvoir distinguer ces séparations ..

Penses-tu que cela est faisable .?
10/02/2017, 14h46
Matthieu.boillon

1 pièce(s) jointe(s)

Pièce jointe 243313

Avec un schéma est plus parlant ^^

Voir 40 message(s) de cette discussion en une page