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
| Windows(strExtractDataFile).Activate
With Sheets("CAL")
For i = 2 To intNbLigneAVAN_cal
'cas1
If (proftub1 <> 0 And .Cells(i, 7) <= proftub1) Then
.Cells(i, 8) = diamnom1
ElseIf (.Cells(i, 14) <= 38 And .Cells(i, 7) > proftub1) Then .Cells(i, 8) = diamnom2
'Else: .Cells(i, 8) = .Cells(i, 14)
'End If
'cas2
ElseIf (proftub2 <> 0 And .Cells(i, 7) > proftub1 And .Cells(i, 7) <= proftub2) Then
.Cells(i, 8) = diamnom2
ElseIf (proftub2 <> 0 And .Cells(i, 14) <= 38 And .Cells(i, 7) > proftub2) Then
.Cells(i, 8) = diamnom3
'Else: .Cells(i, 8) = .Cells(i, 14)
' End If
'cas3
ElseIf (proftub3 <> 0 And .Cells(i, 7) > proftub2 And .Cells(i, 7) <= proftub3) Then
.Cells(i, 8) = diamnom3
ElseIf (proftub3 <> 0 And .Cells(i, 14) <= 38 And .Cells(i, 7) > proftub3) Then .Cells(i, 8) = diamnom4
' Else: .Cells(i, 8) = .Cells(i, 14)
'End If
'cas4
ElseIf (proftub4 <> 0 And .Cells(i, 7) > proftub3 And .Cells(i, 7) <= proftub4) Then
.Cells(i, 8) = diamnom4
ElseIf (proftub4 <> 0 And .Cells(i, 14) <= 38 And .Cells(i, 7) > proftub4) Then .Cells(i, 8) = diamnom5
' Else: .Cells(i, 8) = .Cells(i, 14)
' End If
'cas5
ElseIf (proftub5 <> 0 And .Cells(i, 7) > proftub4 And .Cells(i, 7) <= proftub5) Then
.Cells(i, 2) = diamnom5
ElseIf (proftub5 <> 0 And .Cells(i, 14) <= 38 And .Cells(i, 7) > proftub5) Then .Cells(i, 8) = diamnom6
' Else: .Cells(i, 8) = .Cells(i, 14)
' End If
'cas6
ElseIf (proftub6 <> 0 And .Cells(i, 7) > proftub5 And .Cells(i, 7) <= proftub6) Then
.Cells(i, 2) = diamnom6
ElseIf (proftub6 <> 0 And .Cells(i, 14) <= 38 And .Cells(i, 7) > proftub6) Then .Cells(i, 8) = diamnom6
Else:
.Cells(i, 8) = .Cells(i, 14)
End If
Next i
End With |
Partager