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
|
Sub ChercherTotal()
Dim Tbl1() As Double
Dim Tbl2() As Double
Dim Tbl3() As Double
Dim Tbl4() As Double
Dim Tbl5() As Double
Dim Tbl6() As Double
Dim plage As Range
Dim I As Long
Dim J As Long
Dim K As Long
Dim L As Long
Dim M As Long
Dim N As Long
Dim Max As Long
Dim OK As Boolean
Dim Total As Double
'plage en colonne A
Set plage = Range([a1], Range("A" & Rows.Count).End(xlUp))
'total cherché
Total = Range("c1").Value
'rempli le 1er tableau avec la plage
'(plus rapide que de travailler après sur le range)
For I = 1 To plage.Count
ReDim Preserve Tbl1(1 To I)
Tbl1(I) = plage(I)
Next I
'redimensionne les autres tableaux
ReDim Tbl2(1 To UBound(Tbl1))
ReDim Tbl3(1 To UBound(Tbl1))
ReDim Tbl4(1 To UBound(Tbl1))
ReDim Tbl5(1 To UBound(Tbl1))
ReDim Tbl6(1 To UBound(Tbl1))
'égalité pour les trois tableaux
Tbl2 = Tbl1
Tbl3 = Tbl1
Tbl4 = Tbl1
Tbl5 = Tbl1
Tbl6 = Tbl1
'dimension maximale pour les boucles
Max = UBound(Tbl1)
'moulinette...
For I = 1 To Max
For J = I + 1 To Max
For K = J + 1 To Max
For L = K + 1 To Max
For M = L + 1 To Max
For N = M + 1 To Max
'effectue la comparaison (total des 3 dimensions)
If Tbl1(I) + Tbl2(J) + Tbl3(K) + Tbl4(L) + Tbl5(M) + Tbl6(N) = Total Then
'colore en rouge les 3 cellules correspondantes
plage(I).Interior.ColorIndex = 4
plage(J).Interior.ColorIndex = 4
plage(K).Interior.ColorIndex = 4
plage(L).Interior.ColorIndex = 4
plage(M).Interior.ColorIndex = 4
plage(N).Interior.ColorIndex = 4
'afficher les plage vers une autre plage
Range("e1").Value = plage(I).Value
Range("e2").Value = plage(J).Value
Range("e3").Value = plage(K).Value
Range("e4").Value = plage(L).Value
Range("e5").Value = plage(M).Value
Range("e6").Value = plage(N).Value
'résultat OK, fin de procédure
OK = True
Exit Sub
End If
Next N
Next M
Next L
Next K
Next J
Next I
'si pas trouvé
If OK = False Then
MsgBox "Aucune combinaison possible !"
End If
End Sub |
Partager