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
| Sub mise_en_tableau4()
Dim tableau_avec_calcul_index(256, 2, 2), tableau_un_ou_deux(256, 8), tableau_binaire(2, 4), i, j, x As Integer
Dim i1, i2, i3, i4, i5, i6, i7, i8 As Byte
Dim iLigne As Long
' Chargement d'un tableau Excel en tableau VBA
' on traite la première ligne puis la seconde
For i = 1 To 2
' on traite la première colonne puis la seconde...
For j = 1 To 4
tableau_binaire(i - 1, j - 1) = Cells(i, j).Value
Next
Next
' Pour établir une série de variables qui représentent toutes les combinaisons de 1 à 2 (soit 2^8=256 combinaisons possibles)
' je boucle pour chacune des huit cellules sur la ligne entre 1 et 2
' il faut imaginer un arbre avec 2 racines qui produisent 2 racines, qui produisent 2 racines...
iLigne = 0
For i1 = 1 To 2
For i2 = 1 To 2
For i3 = 1 To 2
For i4 = 1 To 2
For i5 = 1 To 2
For i6 = 1 To 2
For i7 = 1 To 2
For i8 = 1 To 2
tableau_un_ou_deux(iLigne, 0) = i1
tableau_un_ou_deux(iLigne, 1) = i2
tableau_un_ou_deux(iLigne, 2) = i3
tableau_un_ou_deux(iLigne, 3) = i4
tableau_un_ou_deux(iLigne, 4) = i5
tableau_un_ou_deux(iLigne, 5) = i6
tableau_un_ou_deux(iLigne, 6) = i7
tableau_un_ou_deux(iLigne, 7) = i8
Cells(iLigne + 1, 9) = tableau_un_ou_deux(iLigne, 0)
Cells(iLigne + 1, 10) = tableau_un_ou_deux(iLigne, 1)
Cells(iLigne + 1, 11) = tableau_un_ou_deux(iLigne, 2)
Cells(iLigne + 1, 12) = tableau_un_ou_deux(iLigne, 3)
Cells(iLigne + 1, 13) = tableau_un_ou_deux(iLigne, 4)
Cells(iLigne + 1, 14) = tableau_un_ou_deux(iLigne, 5)
Cells(iLigne + 1, 15) = tableau_un_ou_deux(iLigne, 6)
Cells(iLigne + 1, 16) = tableau_un_ou_deux(iLigne, 7)
iLigne = iLigne + 1
Next i8
Next i7
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
' Anciennement le calcul de l'index
For x = 0 To 255
For i = 0 To 1
For j = 0 To 1
tableau_avec_calcul_index(x, i, j) = tableau_un_ou_deux(x, 4 * tableau_binaire(i, j) + 2 * tableau_binaire(i, j + 1) + tableau_binaire(i, j + 2) + 1)
Next
Next
Next
' transcription de la formule Excel R1=SI(ET(EST.PAIR(F1);EST.PAIR(G1));1;0)
Dim tableau_pair_ou_impair(256, 2) As Byte
Dim numligne As Integer
numligne = 1
For x = 0 To 255
' deux cases à remplir donc on boucle sur deux indices 0 et 1
For i = 0 To 1
' Variable Mod 2 permet de calculer le rompu de la division par deux (rompu = ce qu'il y a après la virgule)
' si pas de rompu, c'est que le chiffre est pair
If (tableau_avec_calcul_index(x, i, 0) Mod 2 = 0) And (tableau_avec_calcul_index(x, i, 1) Mod 2 = 0) Then
tableau_pair_ou_impair(x, i) = 1
Else
tableau_pair_ou_impair(x, i) = 0
End If
Cells(x + 1, 18 + i).Value = tableau_pair_ou_impair(x, i)
If i = 1 And tableau_pair_ou_impair(x, 0) = 1 And tableau_pair_ou_impair(x, 1) = 1 Then
Cells(numligne, 30).Value = tableau_un_ou_deux(x, 0)
Cells(numligne, 31).Value = tableau_un_ou_deux(x, 1)
Cells(numligne, 32).Value = tableau_un_ou_deux(x, 2)
Cells(numligne, 33).Value = tableau_un_ou_deux(x, 3)
Cells(numligne, 34).Value = tableau_un_ou_deux(x, 4)
Cells(numligne, 35).Value = tableau_un_ou_deux(x, 5)
Cells(numligne, 36).Value = tableau_un_ou_deux(x, 6)
Cells(numligne, 37).Value = tableau_un_ou_deux(x, 7)
numligne = numligne + 1
End If
Next
Next
End Sub |