Probléme d'optimisation de temps : Trie à conditions

Version imprimable

14/08/2016, 12h57
yobor

1 pièce(s) jointe(s)

Probléme d'optimisation de temps : Trie à conditions

Bonjour à tous,
Je suis en train de résoudre un problème d’optimisation, et je suis arrêté devant un problème de tri à conditions, j’ai essayé de chercher une solution mais ça été très difficile pour moi. Mon problème est le suivant :
J’ai deux colonnes, « coté 1 » et « coté 2 », chaque colonne contient des références des outils changeables des machines de production, et à chaque changement d’outil je perde 20 min, c à d :si la case
A(i) =16041501Z et A(i+1) =E00022577 ça signifie que j’ai changé l’outil 16041501Z avec l’outil E00022577 et alors j’ai perdu 20 min et s’il y a un changement dans les deux colonnes c à d : A(i) diffèrent de A(i+1) et B(i) diffèrent de B(i+1) j’ai perdu 20 min +20min =40 min.
Mon objectif est de trier les deux colonnes de tel sort que le temps de changement des outils sera le minimum possible, c à d minimiser les changements au niveau des deux colonnes !. Vous trouvez mon fichier au dessous
je vous serez très reconnaissent si vous m'aidez :)
14/08/2016, 18h00
eriiic

Bonjour,

Peux-tu préciser si coté 1 et coté 2 sont interchangeables pour chaque ligne ?
eric
14/08/2016, 18h29
yobor

bonjour eriiic ,
oui ,les deux cotés sont interchangeables pour chaque ligne
14/08/2016, 19h04
eriiic

Pas trop d'idée pour l'instant mais ton fichier n'est pas propre.
Il y a des outils douteux comme 3.20256E+13
et d'autres comme "32025Y18Z " (coté 2)
14/08/2016, 20h07
yobor

Les cases contiennent des références des outils, c à d que chaque outil a une référence ou bien un « nom » qui ne contient pas nécessairement que des chiffres mais aussi des caractères.
14/08/2016, 20h26
eriiic

ok.
Mais 3.20256E+13 correspond à 32025600000000 !?!
et
32025Y18 ou 32025Y18 suivi de 10 espaces ce n'est pas pareil pour excel.
Tes outils ont plutôt l'air d'avoir 9 car.
Pour nous ça ne change rien, pour toi c'est à voir...

Bonsoir à tous, :P

yobor, je n'ai pas pigé ce que tu souhaitais faire. :cfou:
Pour y voir plus clair, je me suis contenté de regrouper les réferences identiques dans un même bloc.

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
65
66
67
Option Explicit
Sub test()
Dim a, w(), t As Byte, i As Long, n As Long, x, y
    With Sheets("Sheet1").Cells(1).CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For t = 1 To 2
                For i = 2 To UBound(a, 1)
                    If a(i, t) <> "" Then
                        If Not .exists(a(i, t)) Then
                            ReDim w(1 To 3)
                            ReDim tablo(1 To 2, 1 To 1)
                        Else
                            w = .Item(a(i, t))
                            tablo = w(3)
                        End If
                        w(t) = w(t) + 1
                        If UBound(tablo, 2) < Application.Max(w(1), w(2)) Then
                            ReDim Preserve tablo(1 To 2, 1 To UBound(tablo, 2) + 1)
                        End If
                        tablo(t, w(t)) = a(i, t)
                        w(3) = tablo
                        .Item(a(i, t)) = w
                    End If
                Next
            Next
            x = .keys: y = .items
        End With
    End With
    Application.ScreenUpdating = False
    'Restitution et mise en forme
    On Error Resume Next
    Application.DisplayAlerts = False
    Sheets("Restitution").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
    Sheets.Add.Name = "Restitution"
    With Sheets("Restitution").Cells(1)
        .Parent.Cells.Clear
        .Resize(1, UBound(a, 2)) = a
        n = 1
        For i = 0 To UBound(x)
            With .Offset(n).Resize(UBound(y(i)(3), 2), UBound(y(i)(3), 1))
                .Value = Application.Transpose(y(i)(3))
                .BorderAround Weight:=xlThin
                n = n + .Rows.Count
            End With
        Next
        With .CurrentRegion
            .Borders(xlInsideVertical).Weight = xlThin
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            .HorizontalAlignment = xlCenter
            With .Rows(1)
                .Font.Bold = True
                .BorderAround Weight:=xlThin
                .Cells(1).Interior.ColorIndex = 44
                .Cells(2).Interior.ColorIndex = 43
            End With
            .Columns.AutoFit
        End With
        .Parent.Activate
    End With
    Application.ScreenUpdating = True
End Sub

Après on fait quoi :weird:

klin89

14/08/2016, 22h15
yobor

1 pièce(s) jointe(s)

Salut les amis :), merci pour votre aide
Je pense que je n’ai pas bien expliqué mon problème, voici un exemple que j’ai essayé de le schématiser dans l'image si dessous pour que vous puissiez bien comprendre le type de tri que j'ai besoin
Pièce jointe 217898

Re yobor, :D

Pas mieux, après ça dépasse mes compétences :aie:

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
65
66
67
68
69
70
71
72
73
74
75
Option Explicit
Sub test()
Dim a, i As Long, j As Long, w(), n As Long, e
    With Sheets("Sheet1").Cells(1).CurrentRegion
        a = .Value
        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 2)) Then
                    ReDim w(1 To UBound(a, 2), 1 To 1)
                Else
                    w = .Item(a(i, 2))
                    ReDim Preserve w(1 To UBound(a, 2), 1 To UBound(w, 2) + 1)
                End If
                For j = 1 To UBound(a, 2)
                    w(j, UBound(w, 2)) = a(i, j)
                Next
                .Item(a(i, 2)) = w
            Next
            n = 1
            For Each e In .keys
                w = .Item(e)
                For i = 1 To UBound(w, 2)
                    n = n + 1
                    For j = 1 To UBound(w, 1)
                        a(n, j) = w(j, i)
                    Next
                Next
            Next
            .RemoveAll
            For i = 2 To UBound(a, 1)
                If Not .exists(a(i, 1)) Then
                    ReDim w(1 To UBound(a, 2), 1 To 1)
                Else
                    w = .Item(a(i, 1))
                    ReDim Preserve w(1 To UBound(a, 2), 1 To UBound(w, 2) + 1)
                End If
                For j = 1 To UBound(a, 2)
                    w(j, UBound(w, 2)) = a(i, j)
                Next
                .Item(a(i, 1)) = w
            Next
            w = .items
        End With
        'Restitution
        Application.ScreenUpdating = False
        With .Offset(, .Columns.Count + 1)
            .CurrentRegion.Clear
            .Rows(1).Value = a: n = 2
            For i = 0 To UBound(w)
                With .Rows(n).Resize(UBound(w(i), 2))
                    .Value = Application.Transpose(w(i))
                    .Borders(xlEdgeBottom).Weight = xlMedium
                End With
                n = n + UBound(w(i), 2)
            Next
            With .CurrentRegion
                .BorderAround Weight:=xlThin
                .Borders(xlInsideVertical).Weight = xlThin
                .Font.Name = "calibri"
                .Font.Size = 10
                .VerticalAlignment = xlCenter
                .HorizontalAlignment = xlCenter
                With .Rows(1)
                    .Font.Bold = True
                    .BorderAround Weight:=xlThin
                    .Cells(1).Interior.ColorIndex = 44
                    .Cells(2).Interior.ColorIndex = 43
                End With
                .Columns.AutoFit
            End With
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

15/08/2016, 23h58
yobor

Merci infiniment Klin89, cette solution me convient très bien :), j'ai une petite demande si ça ne vous dérange pas, c'est d'intégrer quelques commentaires dans le code pour que je le bien comprendre bien ou cas où j'ai besoin de modifier quelque chose et merci beaucoup encore.