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 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176
| Sub Traitement1()
'Transforme la plage en tableau
Sheets("J P").Select
Dim Ws As Worksheet
Dim NomTable As String
NomTable = "Table1"
Set Ws = Worksheets("J P")
With Ws
.ListObjects.Add(xlSrcRange, .Range("$A$1").CurrentRegion, , xlYes).Name = NomTable
.ListObjects(NomTable).TableStyle = "TableStyleLight9"
End With
'Compte le nombre de lignes de la Table1
nblignes = Range("Table1").Rows.Count + 1
Ctiti= Sheets("J P").Rows("1:1").Find("TITI", , xlValues, xlPart, xlByRows, xlNext, False).Column
'Applique le format nombre aux cellules non vides de la colonne TITI
Sheets("J P").Range(Cells(2, Ctiti), Cells(nblignes, Ctiti)).EntireColumn.SpecialCells(xlCellTypeConstants).NumberFormat = "0.00"
End Sub
__________________________________________________________________________________________________________________________
Sub Traitement2()
'Variable a = Ligne chc ET colonne numéro 13
Dim Ctoto As String, Ctata As String, Ctiti As String, Ctutu As String, Ctyty As String, Ctete As String, Ctoutou As String, Ctautau As String
Ctoto= Sheets("J P").Rows("1:1").Find("TOTO", , xlValues, xlPart, xlByRows, xlNext, False).Column
Ctata= Sheets("J P").Rows("1:1").Find("TATA", , xlValues, xlPart, xlByRows, xlNext, False).Column
Ctiti= Sheets("J P").Rows("1:1").Find("TITI", , xlValues, xlPart, xlByRows, xlNext, False).Column
Ctutu = Sheets("J P").Rows("1:1").Find("TUTU", , xlValues, xlPart, xlByRows, xlNext, False).Column
Ctyty = Sheets("J P").Rows("1:1").Find("TYTY", , xlValues, xlPart, xlByRows, xlNext, False).Column
Ctete = Sheets("J P").Rows("1:1").Find("TETE", , xlValues, xlPart, xlByRows, xlNext, False).Column
Ctoutou = Sheets("J P").Rows("1:1").Find("TOUTOU", , xlValues, xlPart, xlByRows, xlNext, False).Column
Ctautau = Sheets("J P").Rows("1:1").Find("TAUTAU", , xlValues, xlPart, xlByRows, xlNext, False).Column
a = CStr(Cells(chc, Ctoto))
'Variable b = Ligne chc ET colonne numéro 31
b = CStr(Cells(chc, Ctata))
c = CStr(Cells(chc, Ctiti))
D = CStr(Cells(chc, Ctutu ))
For chc = 2 To nblignes
'SI cellule(ligne chc, colonne n°20) est vide, alors = 100
If c = 0 Or c = Empty Or c = Null Then
Cells(chc, CQuotite) = "100"
End If
'SI Cellule A = 499040000, alors, Cellules(LigneCHC et Colonne n°Ctiti) = 100
If a = "499040000" Then
Cells(chc, Ctiti) = "100"
'colorie la cellule en fond vert
With Cells(chc, Ctiti).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'SI A = 1058020000 ou 1058040000 ou 652040000 ou15020000, alors Cellules(lignechc, colonne n°Ctiti) = 50
ElseIf a = "1058020000" Or a = "1058040000" Or a = "652040000" Or a = "15020000" Then
Cells(chc, Ctiti) = "50"
'Colorie le fond de la cellule en vert
With Cells(chc, Ctiti).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'Si a = 499010000 ou 499020000 ou 1577010000 ou 500910000 ou 500010000, alors Cellules(lignechc, colonne n°Ctoto = HP
ElseIf a = "499010000" Or a = "499020000" Or a = "1577010000" Or a = "500910000" Or a = "500010000" Then
Cells(chc, Ctoto) = "HP"
'Colorie le fond de la cellule en vert
With Cells(chc, Ctoto).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'alors, cellule(lignechc, colonne n°20) = 0
Cells(chc, Ctiti) = "0"
'Colorie le fond de la cellule en vert
With Cells(chc, Ctiti).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'SI a = 500900000 ET b = CRPOFIHESDAC alors, Cellules(lignes chc, colonne n°20) = 0
ElseIf a = "500900000" And b = "CRPOFIHESDAC " Then
Cells(chc, Ctiti) = "0"
'Colorie le fond de la cellule en vert
With Cells(chc, Ctiti).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
'alors cellule(ligne chc, colonne Ctyty )
Cells(chc, Ctyty ) = "HP"
With Cells(chc, CLibPlafDec).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
'SI Cellule(ligne chc, colonne n°20) = "85.71" alors cellule (ligne chc, colonne n°Ctiti) = 80
If c = "85.71" Then
Cells(chc, Ctiti) = "80"
'Colorie le fond de la cellule en vert
With Cells(chc, Ctiti).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
'SI cellule(ligne chc, colonne n°41) est vide ET cellule(ligne chc, colonne n°42) est vide ET cellule(ligne chc, colonne n°43) est vide, alors cellule(ligne chc, colonne n°20 = 0
If Cells(chc, Ctautau ) = "" And Cells(chc, CRCngFormNE) = "" And Cells(chc, CRApprt) = "" Then
Cells(chc, Ctiti) = "0"
'Colorie le fond de la cellule en vert
With Cells(chc, CQuotite).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
',alors cellule(ligne chc, colonne n°27) = HP
Cells(chc, Ctautau ) = "HP"
'Colorie le fond de la cellule en vert
With Cells(chc, CLibPlafDec).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
If D = Empty Or D = Null Then
Cells(chc, CLibPlafDec).Value = Cells(chc, CLibPlafEmp).Value
'SI cellule(ligne chc, colonne n°27) est vide alors Cellule(ligne chc, colonne n°27) est égal à cellule (ligne chc, colonne n°26)
End If
If c = "0" Then
Cells(chc, Ctautau ) = "HP"
With Cells(chc, CLibPlafDec).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next chc
For varble1 = 2 To nblignes
If Cells(varble1, Ctiti) = "0" Then
Cells(varble1, Ctautau ) = "HP"
With Cells(varble1, Ctautau ).Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 10092288
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next varble1
Set a = Nothing
Set b = Nothing
Set c = Nothing
Set D = Nothing
Set nblignes = Nothing
End Sub |
Partager