Option Explicit
Sub MacroCode_JJ1()
Application.ScreenUpdating = False
Worksheets("Feuil2").Cells(1, 1) = "Depart Macro : " & Time
' Compteur
Dim cpt1 As Double
Dim cpt2 As Double
Dim cpt3 As Double
Dim val As Integer
Dim col As Integer
Dim resTest As Double
cpt3 = 1
col = 1
'Dim Tab1() As Double
Dim x As Double
Dim y As Double
x = 12103014 ' lignes max de données possible
y = Round((12103014 / 1048576))
'ReDim Tab1(1 To y)
Dim Tab2() As Double
ReDim Tab2(1 To 1048576, 1 To 5)
Dim Tab3() As Double
ReDim Tab3(1 To 1048576, 1 To 5)
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim e As Integer
'Dim f As Integer
For a = 1 To 70
For b = a + 1 To 70
For c = b + 1 To 70
'Application.Wait (Now + TimeValue("0:00:01"))
For d = c + 1 To 70
For e = d + 1 To 70
Application.StatusBar = "For pos a = " & a & " (soit 70 reste " & 70 - a & " )" & " / " & _
"For pos b = " & b & " (soit 70 reste " & 70 - b & " )" & " / " & _
"For pos c = " & c & " (soit 70 reste " & 70 - c & " )" & " / " & _
"For pos d = " & d & " (soit 70 reste " & 70 - d & " )" & " / " & _
"For pos e = " & e & " (soit 70 reste " & 70 - e & " )" & " / "
If cpt2 = 1048576 Then
cpt2 = Empty
End If
cpt2 = cpt2 + 1
'Fonction
resTest = TestR1(Tab2, a, b, c, d, e, cpt2)
'If resTest = 0 Then
cpt3 = TransfertCondition(Tab2, Tab3, cpt2, cpt3, col)
'End If
If cpt3 > 1048576 Then
col = TransfertExcel(Tab3, col)
cpt3 = 1
End If
Next e
Next d
Next c
Next b
Next a
Worksheets("Feuil2").Cells(1, 3) = "Fin Macro : " & Time
'Erase Tab1, Tab2
Erase Tab2, Tab2
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Public Function TestR1(Tab2, a, b, c, d, e, cpt2)
Dim resTest As Double
Tab2(cpt2, 1) = a
Tab2(cpt2, 2) = b
Tab2(cpt2, 3) = c
Tab2(cpt2, 4) = d
Tab2(cpt2, 5) = e
resTest = Tab2(cpt2, 1) & Tab2(cpt2, 2) & Tab2(cpt2, 3) & Tab2(cpt2, 4) & Tab2(cpt2, 5)
TestR1 = resTest
End Function
Function TransfertCondition(Tab2, Tab3, cpt2, cpt3, col)
Tab3(cpt3, 1) = Tab2(cpt2, 1)
Tab3(cpt3, 2) = Tab2(cpt2, 2)
Tab3(cpt3, 3) = Tab2(cpt2, 3)
Tab3(cpt3, 4) = Tab2(cpt2, 4)
Tab3(cpt3, 5) = Tab2(cpt2, 5)
cpt3 = cpt3 + 1
TransfertCondition = cpt3
End Function
Function TransfertExcel(Tab3, col)
Cells(1, col).Resize(UBound(Tab3, 1), UBound(Tab3, 2)) = Tab3
col = col + 6
TransfertExcel = col
End Function
