Tri et sélection random de distances

**papouuu** · 30/05/2012, 11h26

Bonjour,

Alors je ne m'y connais pas du tout en Macros Excel alors je viens poser mon problème auprès d'experts

J'ai un fichier excel tout simple avec des trajets en col A et les distances en col B, je dois renvoyer un ensemble de trajets aléatoires en fonction d'une distance entrée par l'utilisateur à plus ou moins 10 près.

C'est à dire en entrant 320 par exemple le fichier pourra me sortir:
- Trajet 3 : 120
- Trajet 7 : 70
- Trajet 8 : 120

Ou bien
- Trajet 1 : 280
- Trajet 6 : 45

Auriez-vous quelque chose à me proposer, ou au moins des pistes de fonction qui pourraient m'être utiles?

Merci d'avance

**ZebreLoup** · 30/05/2012, 11h38

C'est plus un problème d'algorithme que de VBA. On pourra bien sûr t'aider un peu pour le VBA, mais pour la partie algorithme, tu as déjà pensé à une solution ?

**papouuu** · 30/05/2012, 11h56

J'ai pensé à ceci:

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
Select distances < donnée
envoyer cell + valeur dans Array
 
Tant que (Array.MaxValue + Array.MinValue > donnée + 10)
Supprimer Array.MaxValue de Array
Fin Tant que
 
Array finalCells
 
Select random valeur in Array = rdm1
int test = rdm1
 
finalCells.add(rdm1.cell.line)
 
Tant que (test < donnée + 10)
rdm2 = Select random valeur in Array (sans rdm1) where (donnée - rdm1 < rdm2 + 10)
test += rdm2
finalCells.add(rdm2.cell.line)
Fin Tant que
 
retourner ColonneA.line(finalCells) + test

Ca me semble correspondre à mon besoin, j'espère que c'est suffisament clair :s

**ZebreLoup** · 30/05/2012, 12h11

Je peux me tromper, mais je n'ai pas l'impression que ça fasse ce que tu veux.

Déjà, oublions pour le moment le coté aléatoire. Une première étape est de trouver l'algorithme qui permet de trouver toutes les combinaisons de trajet qui font valeurCible +- 10 km.

**papouuu** · 30/05/2012, 14h48

oui ok je vois ce que tu veux dire, j'ai pensé à ceci alors:

Par contre je ne sais pas si c'est faisable comme je ne connais pas du tout VBA et la portée des variables:

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
Fonction MAIN:
 
int TotalFinal
 
Array Valeurs = tableau associatif clé=ligne, valeur=valeur (ensemble des distances)
 
Array Final = tableau associatif clé=ligne, valeur=valeur (vide)
 
foreach val in Valeurs
Vider Final
function(Valeurs, val, donnée)
ecrire Final et TotalFinal
fin foreach
 
fin Main
 
 
function(Array Vals, int Actual, int donnée)
 
foreach(valeur in Vals)
Array temp
 
si((valeur + Actual < donnée + 10) AND (valeur + Actual > donnée - 10))
Actual += valeur
temp.add(valeur)
TotalFinal = Actual
Final = temp
 
sinon si(valeur + Actual < donnée + 10 - Vals.MinValue)
Actual += valeur
temp.add(valeur)
Supprimer valeur dans Vals
function(Vals, Actual, donnée)
 
fin si
fin foreach
fin function

Ca pourrait aller pour la recherche des trajets à +ou- la donnée entrée?

**papouuu** · 31/05/2012, 16h28

Une petite aide pour me corriger ca please

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
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
 
Dim tab_exemple()
Dim TotalFinal As Integer
Dim temp()
Dim longTemp As Integer
Dim Final()
Dim cellule As Integer
 
 
Sub Test1()
 
    Dim zz As Integer
    zz = Range("D1").Value
 
 
    Dim derniere_ligne
    derniere_ligne = Range("A1").End(xlDown).Row
 
 
    ReDim tab_exemple(derniere_ligne - 1, 2)
    ReDim Final(derniere_ligne - 1, 2)
    cellule = 4
    For i = 0 To derniere_ligne - 1
        tab_exemple(i, 0) = i + 1
        tab_exemple(i, 1) = Range("B" & i + 1)
    Next
 
    For i = 0 To derniere_ligne - 1
        'Erase Final
        Dim actu As Integer
        actu = tab_exemple(i, 1)
        Dim x
 
        For u = i + 1 To UBound(tab_exemple)
            tab_exemple(u - 1, 0) = tab_exemple(u, 0)
            tab_exemple(u - 1, 1) = tab_exemple(u, 1)
        Next
 
        x = Multiplication(actu, zz, tab_exemple)
 
        'MsgBox TotalFinal
        If x Then
            For f = 0 To UBound(Final) - 1
                If Final(f, 0) <> "" Then
                Range("D" & cellule).Value = Range("D" & cellule).Value & " " & Final(f, 1) & "haha"
                End If
            Next
        End If
 
        cellule = cellule + 1
    Next
 
 
    'Erase tab_exemple
 
 
End Sub
 
 
Function Multiplication(ByVal Actual As Integer, ByVal donnee As Integer, ByRef Tabl() As Variant) As Boolean
 
 
    Dim longueur As Integer
    longueur = UBound(Tabl, 1)
    ReDim temp(longueur, 2)
 
    Multiplication = False
 
 
    For i = 0 To longueur
 
 
        'Dim indice As Long
 
        'On Error GoTo vide
           ' longTemp = UBound(tableau)
 
'vide:        longTemp = 0
 
        'Dim Tmp As Variant
 
        'On Error Resume Next
            'Tmp = UBound(temp)
        'On Error GoTo 0
 
        'If IsEmpty(Tmp) Then
           ' longTemp = 0
       ' Else
       '     longTemp = longTemp + 1
       ' End If
 
 
        Dim valeur As Integer
        Dim Line As Integer
 
 
        valeur = Tabl(i, 1)
        Line = Tabl(i, 0)
 
 
        Dim ValMin
        ValMax = 500000000
        For Z = LBound(tab_exemple) + 1 To UBound(tab_exemple)
            If tab_exemple(Z, 1) < ValMin Then ValMin = tab_exemple(Z, 1)
        Next
 
        If valeur + Actual < donnee + 10 And valeur + Actual > donnee - 10 Then
            Actual = Actual + valeur
            temp(longTemp, 0) = Line
            temp(longTemp, 1) = valeur
            TotalFinal = Actual
            For t = 0 To longTemp
                'If IsEmpty(Final(t, 1)) Then
                Dim h
                h = temp(t, 0)
                Dim g
                g = temp(t, 1)
 
                Final(t, 0) = h
                Final(t, 1) = g
                'End If
            Next
 
            Multiplication = True
 
        ElseIf valeur + Actual < donnee + 10 - ValMin Then
            Actual = Actual + valeur
 
            temp(longTemp, 0) = Line
            temp(longTemp, 1) = valeur
 
 
            For x = i + 1 To UBound(Tabl)
                Tabl(Line - 1, 0) = Tabl(Line, 0)
                Tabl(Line - 1, 1) = Tabl(Line, 1)
            Next
            If longTemp < UBound(Tabl) Then
            longTemp = longTemp + 1
            End If
            'ReDim Preserve Tabl(UBound(Tabl))
            Multiplication = Multiplication(Actual, donnee, Tabl)
 
 
 
        End If
 
 
    Next
    'tab_exemple(1, 1) = "tata"
End Function

**papouuu** · 31/05/2012, 19h59

Sérieux, tellement de monde sur ce forum et pas un pour filer un coup de main

Edit: Merci pour votre aide précieuse, j'ai enfin réussi

Tri et sélection random de distances [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager