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
|
Option Explicit
Sub matrice()
Dim a As Integer, b As Integer, x As Integer, y As Integer, tIndic() As Variant, tIndic2() As String, aa As Integer, bb As Integer, compt As Integer
Dim tCompteuretat() As String, tCompteur() As Integer, indicateur As String
Sheets("Feuilles_rondes").Activate
ActiveSheet.Unprotect
a = Range("C65536").End(xlUp).Row
b = a - 8
ReDim tCompteuretat(b) As String
ReDim tCompteur(b) As Integer
ReDim tIndic(b, 11, 3) As Variant
ReDim tIndic2(b, 3) As String
For x = 0 To b
tCompteuretat(x) = Cells(x + 8, 13).Value
tCompteur(x) = Cells(x + 8, 14).Value
tIndic(x, 0, 0) = Cells(x + 8, 4).Value
tIndic(x, 1, 0) = Cells(x + 8, 3).Value
For y = 0 To 7
Cells(x + 8, y + 15).Activate
'si la cellule n'est pas vide
If ActiveCell.Value <> "" Then
'affecter sa valeur au premier niveau de la matrice tIndic
tIndic(x, y + 2, 0) = Sheets("Feuilles_rondes").Cells(x + 8, y + 15).Value
'affecter le titre de la ligne au deuxieme niveau de la matrice tIndic
tIndic(x, y + 2, 1) = Sheets("Feuilles_rondes").Cells(x + 8, 4).Value
'affecter le titre de la colonne au dernier niveau de la matrice
tIndic(x, y + 2, 2) = Sheets("Feuilles_rondes").Cells(7, y + 15).Value
End If
Next y
Next x
For x = LBound(tIndic, 1) To UBound(tIndic, 1)
compt = 0
For y = LBound(tIndic, 2) + 2 To UBound(tIndic, 2) - 1
If tIndic(x, y, 0) = "X" Then compt = compt + 1
tIndic(x, 10, 0) = compt
Next y
Next x
Sheets("Déboguage").Activate
aa = 0
For x = 0 To UBound(tIndic, 1)
aa = aa + 1
If tIndic(x, 10, 0) = 0 Then
'If tCompteur(x) <> Empty Then
ActiveSheet.Cells(1, aa + 3) = tIndic(x, 0, 0)
ActiveSheet.Cells(2, aa + 3) = tIndic(x, 1, 0)
'End If
Else:
For y = 2 To 9
If tIndic(x, y, 2) <> Empty Then
indicateur = tIndic(x, 0, 0) & " | " & tIndic(x, y, 2)
ActiveSheet.Cells(1, aa + 3) = tIndic(x, 0, 0)
ActiveSheet.Cells(2, aa + 3) = tIndic(x, 1, 0)
aa = aa + 1
ActiveSheet.Cells(2, aa + 3) = tIndic(x, 1, 0)
ActiveSheet.Cells(1, aa + 3) = indicateur
End If
Next y
End If
Next x
'Sheets("Déboguage").Activate
'For x = 0 To UBound(tIndic, 1)
' For y = 0 To UBound(tIndic, 2)
' ActiveSheet.Cells(x + 1, y + 1) = tIndic(x, y, 2)
' Next y
'Next x
End Sub |
Partager